Commit 4a85ae1b authored by partain's avatar partain

[project @ 1996-07-25 21:02:03 by partain]

Bulk of final changes for 2.01
parent 51c80c6c
--!!! conversions: Double <=> Rational/Integer things
--
main _
= [AppendChan stdout
(show r42 ++ "\n" ++
show nu42 ++ ", " ++
show de42 ++ "\n" ++
show nu42d ++ ", " ++
show de42d ++ "\n" ++
show s2 ++ ", " ++
show e2 ++ "\n" ++
show s ++ ", " ++
show e ++ "\n" )
]
import Ratio
main = putStr (show r42 ++ "\n" ++
show nu42 ++ ", " ++
show de42 ++ "\n" ++
show nu42d ++ ", " ++
show de42d ++ "\n" ++
show s2 ++ ", " ++
show e2 ++ "\n" ++
show s ++ ", " ++
show e ++ "\n" )
where
d42 :: Double
r42 :: Rational
......
--!!! basic Rational operations
--
main _
= [AppendChan stdout
import Ratio
main
= putStr
(-- Ratio Ints
show [i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc]
++ "\n"
......@@ -24,7 +26,6 @@ main _
-- ++ show []
-- ++ "\n"
)
]
where
i0a, i0b, i0c, i2a, i2b, im2a, im2b, i_pi, i_misc :: Ratio Int
......
--!!! test arithmetic operations from "Prelude" (gcd, ldm, etc.)
--
main _
= [AppendChan stdout
main
= let
minInt = minBound :: Int
maxInt = maxBound :: Int
in
putStr
(-- w/ Ints
show [
minInt, maxInt,
......@@ -62,7 +66,7 @@ main _
-- ToDo: more stuff
]
++ "\n"
)]
)
where
i0, i4, i4m, i6, i6m, i8, i8m :: Int
i0 = 0
......
--!!! test quot/rem/div/mod functions on Ints and Integers
--
main _
= [AppendChan stdout
main
= putStr
(-- w/ Ints and Integers
show (unzipWith div ints_list)
++ "\n"
......@@ -27,7 +27,7 @@ main _
++ "\n"
++ show (unzipWith law2 integers_list)
++ "\n"
)]
)
where
ints_list :: [(Int, Int)]
integers_list :: [(Integer, Integer)]
......
--!!! test RealFrac ops (ceiling/floor/etc.) on Floats/Doubles
--
main _
= [AppendChan stdout
main
= putStr
(-- {Float,Double} inputs, {Int,Integer} outputs
show ((map ceiling float_list) :: [Int])
++ "\n"
......@@ -43,7 +43,7 @@ main _
++ "\n"
++ show ((map properFraction double_list) :: [(Integer,Double)])
++ "\n"
)]
)
where
float_list :: [Float]
double_list :: [Double]
......
42.0000000
\ No newline at end of file
42.0000000
--!!! test simple Integer things
--
main _
= [AppendChan stdout (shows integer_list "\n")]
main
= putStr (shows integer_list "\n")
where
int_list :: [Int]
integer_list :: [Integer]
......
......@@ -14,7 +14,7 @@ random_numbers (s1,s2,s3)
-- partain: changed to cvt spaces into newlines (easier to see bugs)
main = appendChan stdout (map cvt (shows (take 1000 (random_numbers (9807, 65, 32975))) "\n")) exit done
main = putStr (map cvt (shows (take 1000 (random_numbers (9807, 65, 32975))) "\n"))
where
cvt ' ' = '\n'
cvt c = c
NoFibOneModuleCompileAndRun(arith009,)
-- a prefix minus precedence test
f :: Int -> Int -> Int -> Int
f x y z = - x * y ^ z
main = putStr (shows (f 5 2 3) "\n")
main _ = [AppendChan stdout (shows a "\n")]
import Array -- 1.3
infix 1 =:
(=:) a b = (a,b)
main = putStr (shows a "\n")
where
a :: Array Integer Integer
a = array (1,100) ((1 := 1) : [i := i * a!(i-1) | i <- [2..100]])
a = array (1,100) ((1 =: 1) : [i =: i * a!(i-1) | i <- [2..100]])
This diff is collapsed.
main _ = [AppendChan stdout (shows sub_b "\n")]
import Ratio -- 1.3
import Array -- 1.3
infix 1 =:
(=:) a b = (a,b)
main = putStr (shows sub_b "\n")
where
sub_b :: Array Int Double
sub_b = ixmap (102, 113) id b
......@@ -8,5 +13,5 @@ main _ = [AppendChan stdout (shows sub_b "\n")]
(ixmap (101,200) (\ i -> toInteger i - 100) a)
a :: Array Integer (Ratio Integer)
a = array (1,100) ((1 := 1) : [i := fromInteger i * a!(i-1)
a = array (1,100) ((1 =: 1) : [i =: fromInteger i * a!(i-1)
| i <- [2..100]])
array (102, 113) [102 := 6.3661977236758138e-1, 103 := 1.9098593171027440, 104 := 7.6394372684109761, 105 := 38.197186342054884, 106 := 229.18311805232929, 107 := 1604.2818263663050, 108 := 12834.254610930440, 109 := 115508.29149837396, 110 := 1155082.9149837396, 111 := 12705912.064821135, 112 := 152470944.77785364, 113 := 1982122282.1120973]
array (102, 113) [(102, 6.3661977236758138e-1), (103, 1.9098593171027440), (104, 7.6394372684109761), (105, 38.197186342054884), (106, 229.18311805232929), (107, 1604.2818263663050), (108, 12834.254610930440), (109, 115508.29149837396), (110, 1155082.9149837396), (111, 12705912.064821135), (112, 152470944.77785364), (113, 1982122282.1120973)]
......@@ -26,5 +26,5 @@ where {
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 r = [AppendChan "stdout" (f_main c_input)]
main = putStr (f_main c_input)
}
These are bug-programs (fixed) that I haven't turned into tests yet.
Will
val1 :: Array Int Int
val1 = array (12,10) []
main = print [val1 == val1]
main = prints (exponent (2.0 :: Float), significand (2.0 :: Float),
exponent (2.0 :: Double),significand (2.0 :: Double)) "\n"
> module DataTypes where
> import GenUtils
> import Array -- 1.3
> import Ix
> import Char
> infix 1 =: -- 1.3
> (=:) a b = (a,b)
%------------------------------------------------------------------------------
......@@ -81,8 +86,8 @@ Now the ranks and files.
> userFormatExBoardPos (Just f,Nothing) = userFormatFile f
> userFormatExBoardPos (Nothing,Just r) = userFormatRank r
> userFormatExBoardPos _ = ""
> userFormatRank r = [chr (r + 48)]
> userFormatFile f = [chr (f + 96)]
> userFormatRank r = [toEnum (r + 48)]
> userFormatFile f = [toEnum (f + 96)]
%------------------------------------------------------------------------------
......@@ -243,9 +248,9 @@ These are the components of a move.
> getOpening eco@[a,b,c] | a >= 'A' && a <= 'E' && isDigit b && isDigit c
> = getOpenName ((ord a - ord 'A') * 100
> + (ord b - ord '0') * 10
> + (ord c - ord '0')) ++ " " ++ eco
> = getOpenName ((fromEnum a - fromEnum 'A') * 100
> + (fromEnum b - fromEnum '0') * 10
> + (fromEnum c - fromEnum '0')) ++ " " ++ eco
> getOpening other = other
> getOpenName :: Int -> String
......@@ -549,7 +554,7 @@ This uses forsyth notation.
> buildBoard :: String -> Board
> buildBoard str = Board brd initMoveNumber Nothing
> where
> brd = array boardSize (zipWith (:=) allSq (mkPieces str))
> 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
......
......@@ -33,10 +33,11 @@ All the code below is understood to be in the public domain.
> combinePairs,
> formatText ) where
> import Array -- 1.3
> import Ix -- 1.3
>#ifndef __GLASGOW_HASKELL__
> import {-fool mkdependHS-}
> Maybe (Maybe(..))
> import {-fool mkdependHS-}
> Trace
......@@ -49,9 +50,12 @@ HBC has it in one of its builtin modules
>#if defined(__GLASGOW_HASKELL__) || defined(__GOFER__)
> data Maybe a = Nothing | Just a deriving (Eq,Ord,Text)
> --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 [] = []
......@@ -87,7 +91,7 @@ This version returns nothing, if *any* one fails.
> 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,Text)
> 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,
......@@ -214,15 +218,15 @@ Note again the use of partiual application.
> 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 ] ++
> 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 ]
> where arr = array bds [ t =: f t | t <- range bds ]
Quite neat this. Formats text to fit in a column.
......
......@@ -2,6 +2,7 @@
> import GenUtils
> import DataTypes
> import Array -- 1.3
%------------------------------------------------------------------------------
......@@ -155,7 +156,7 @@ Now filter out the moves it *cant* be.
> -> [(Piece,ChessFile,ChessRank)]
> getCurrPieces (Board arr (MoveNumber _ col) _) pc corr_file =
> [ (p,x,y) |
> ((x,y) := r) <- assocs arr,
> ((x,y), r) <- assocs arr,
> lookupSquare col r == Friendly,
> (Just p) <- [getSquarePiece r],
> p == pc,
......@@ -285,24 +286,24 @@ ToDo: add en-passant
> 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 ])
> 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 ])
> 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])
> 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 ])
> 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)
......@@ -310,29 +311,29 @@ ToDo: add en-passant
> 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
> [ (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
> [ (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
> [ (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
> [ (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)]
......
......@@ -6,6 +6,9 @@
> import Interp
> import PrintTEX
> import System -- 1.3 (partain)
> import Char -- 1.3
> --fakeArgs = "game001.txt"
> --fakeArgs = "pca2.pgn"
> --fakeArgs = "silly.pgn"
......@@ -18,6 +21,15 @@
> 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
......@@ -27,6 +39,7 @@
> 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)
......
......@@ -2,6 +2,7 @@
> import GenUtils
> import DataTypes
> import Char -- 1.3
This is a PGN lexer. Simple, and straightforward.
......
......@@ -2,6 +2,8 @@
> 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.
......
......@@ -20,7 +20,7 @@ instance Wrapper Int where
wrapup a = a `thenIO_Int#` \ x# -> returnIO (I# x#)
instance Wrapper Char where
wrapup a = a `thenIO_Int#` \ x# -> returnIO (chr (I# x#))
wrapup a = a `thenIO_Int#` \ x# -> returnIO (toEnum (I# x#))
instance Wrapper Bool where
wrapup a = a `thenIO_Int#` \ x# -> returnIO (x# /=# 0#)
......@@ -32,7 +32,7 @@ instance Pass Int where
pass (I# i#) = i#
instance Pass Char where
pass c = pass (ord c)
pass c = pass (fromEnum c)
instance Pass Bool where