Commit 46ff80f2 by thomie

### Testsuite: tabs -> spaces [skip ci]

parent 7e7094f1
 ... ... @@ -6,13 +6,13 @@ import Control.Arrow h :: ArrowChoice a => Int -> a (Int,Int) Int h x = proc (y,z) -> case compare x y of LT -> returnA -< x EQ -> returnA -< y+z GT -> returnA -< z+x LT -> returnA -< x EQ -> returnA -< y+z GT -> returnA -< z+x g :: ArrowChoice a => Int -> a (Int,Int) Int g x = proc (y,z) -> (case compare x y of LT -> \ a -> returnA -< x+a EQ -> \ b -> returnA -< y+z+b GT -> \ c -> returnA -< z+x LT -> \ a -> returnA -< x+a EQ -> \ b -> returnA -< y+z+b GT -> \ c -> returnA -< z+x ) 1
 ... ... @@ -12,6 +12,6 @@ g x = proc y -> returnA -< x*y h :: Arrow a => Int -> a (Int,Int) Int h x = proc (y,z) -> do a <- f -< (x,y,3) b <- g (2+x) -< y+a returnA -< a*b+z a <- f -< (x,y,3) b <- g (2+x) -< y+a returnA -< a*b+z
 ... ... @@ -6,5 +6,5 @@ import Control.Arrow f :: Arrow a => a (Int,Int) Int f = proc (x,y) -> do let z = x*y returnA -< y+z let z = x*y returnA -< y+z
 ... ... @@ -79,144 +79,144 @@ data T70 = C70 f :: Arrow a => a Int Int f = proc x0 -> do x1 <- returnA -< C1 x2 <- returnA -< C2 x3 <- returnA -< C3 x4 <- returnA -< C4 x5 <- returnA -< C5 x6 <- returnA -< C6 x7 <- returnA -< C7 x8 <- returnA -< C8 x9 <- returnA -< C9 x10 <- returnA -< C10 x11 <- returnA -< C11 x12 <- returnA -< C12 x13 <- returnA -< C13 x14 <- returnA -< C14 x15 <- returnA -< C15 x16 <- returnA -< C16 x17 <- returnA -< C17 x18 <- returnA -< C18 x19 <- returnA -< C19 x20 <- returnA -< C20 x21 <- returnA -< C21 x22 <- returnA -< C22 x23 <- returnA -< C23 x24 <- returnA -< C24 x25 <- returnA -< C25 x26 <- returnA -< C26 x27 <- returnA -< C27 x28 <- returnA -< C28 x29 <- returnA -< C29 x30 <- returnA -< C30 x31 <- returnA -< C31 x32 <- returnA -< C32 x33 <- returnA -< C33 x34 <- returnA -< C34 x35 <- returnA -< C35 x36 <- returnA -< C36 x37 <- returnA -< C37 x38 <- returnA -< C38 x39 <- returnA -< C39 x40 <- returnA -< C40 x41 <- returnA -< C41 x42 <- returnA -< C42 x43 <- returnA -< C43 x44 <- returnA -< C44 x45 <- returnA -< C45 x46 <- returnA -< C46 x47 <- returnA -< C47 x48 <- returnA -< C48 x49 <- returnA -< C49 x50 <- returnA -< C50 x51 <- returnA -< C51 x52 <- returnA -< C52 x53 <- returnA -< C53 x54 <- returnA -< C54 x55 <- returnA -< C55 x56 <- returnA -< C56 x57 <- returnA -< C57 x58 <- returnA -< C58 x59 <- returnA -< C59 x60 <- returnA -< C60 x61 <- returnA -< C61 x62 <- returnA -< C62 x63 <- returnA -< C63 x64 <- returnA -< C64 x65 <- returnA -< C65 x66 <- returnA -< C66 x67 <- returnA -< C67 x68 <- returnA -< C68 x69 <- returnA -< C69 x70 <- returnA -< C70 returnA -< x70 returnA -< x69 returnA -< x68 returnA -< x67 returnA -< x66 returnA -< x65 returnA -< x64 returnA -< x63 returnA -< x62 returnA -< x61 returnA -< x60 returnA -< x59 returnA -< x58 returnA -< x57 returnA -< x56 returnA -< x55 returnA -< x54 returnA -< x53 returnA -< x52 returnA -< x51 returnA -< x50 returnA -< x49 returnA -< x48 returnA -< x47 returnA -< x46 returnA -< x45 returnA -< x44 returnA -< x43 returnA -< x42 returnA -< x41 returnA -< x40 returnA -< x39 returnA -< x38 returnA -< x37 returnA -< x36 returnA -< x35 returnA -< x34 returnA -< x33 returnA -< x32 returnA -< x31 returnA -< x30 returnA -< x29 returnA -< x28 returnA -< x27 returnA -< x26 returnA -< x25 returnA -< x24 returnA -< x23 returnA -< x22 returnA -< x21 returnA -< x20 returnA -< x19 returnA -< x18 returnA -< x17 returnA -< x16 returnA -< x15 returnA -< x14 returnA -< x13 returnA -< x12 returnA -< x11 returnA -< x10 returnA -< x9 returnA -< x8 returnA -< x7 returnA -< x6 returnA -< x5 returnA -< x4 returnA -< x3 returnA -< x2 returnA -< x1 returnA -< x0 x1 <- returnA -< C1 x2 <- returnA -< C2 x3 <- returnA -< C3 x4 <- returnA -< C4 x5 <- returnA -< C5 x6 <- returnA -< C6 x7 <- returnA -< C7 x8 <- returnA -< C8 x9 <- returnA -< C9 x10 <- returnA -< C10 x11 <- returnA -< C11 x12 <- returnA -< C12 x13 <- returnA -< C13 x14 <- returnA -< C14 x15 <- returnA -< C15 x16 <- returnA -< C16 x17 <- returnA -< C17 x18 <- returnA -< C18 x19 <- returnA -< C19 x20 <- returnA -< C20 x21 <- returnA -< C21 x22 <- returnA -< C22 x23 <- returnA -< C23 x24 <- returnA -< C24 x25 <- returnA -< C25 x26 <- returnA -< C26 x27 <- returnA -< C27 x28 <- returnA -< C28 x29 <- returnA -< C29 x30 <- returnA -< C30 x31 <- returnA -< C31 x32 <- returnA -< C32 x33 <- returnA -< C33 x34 <- returnA -< C34 x35 <- returnA -< C35 x36 <- returnA -< C36 x37 <- returnA -< C37 x38 <- returnA -< C38 x39 <- returnA -< C39 x40 <- returnA -< C40 x41 <- returnA -< C41 x42 <- returnA -< C42 x43 <- returnA -< C43 x44 <- returnA -< C44 x45 <- returnA -< C45 x46 <- returnA -< C46 x47 <- returnA -< C47 x48 <- returnA -< C48 x49 <- returnA -< C49 x50 <- returnA -< C50 x51 <- returnA -< C51 x52 <- returnA -< C52 x53 <- returnA -< C53 x54 <- returnA -< C54 x55 <- returnA -< C55 x56 <- returnA -< C56 x57 <- returnA -< C57 x58 <- returnA -< C58 x59 <- returnA -< C59 x60 <- returnA -< C60 x61 <- returnA -< C61 x62 <- returnA -< C62 x63 <- returnA -< C63 x64 <- returnA -< C64 x65 <- returnA -< C65 x66 <- returnA -< C66 x67 <- returnA -< C67 x68 <- returnA -< C68 x69 <- returnA -< C69 x70 <- returnA -< C70 returnA -< x70 returnA -< x69 returnA -< x68 returnA -< x67 returnA -< x66 returnA -< x65 returnA -< x64 returnA -< x63 returnA -< x62 returnA -< x61 returnA -< x60 returnA -< x59 returnA -< x58 returnA -< x57 returnA -< x56 returnA -< x55 returnA -< x54 returnA -< x53 returnA -< x52 returnA -< x51 returnA -< x50 returnA -< x49 returnA -< x48 returnA -< x47 returnA -< x46 returnA -< x45 returnA -< x44 returnA -< x43 returnA -< x42 returnA -< x41 returnA -< x40 returnA -< x39 returnA -< x38 returnA -< x37 returnA -< x36 returnA -< x35 returnA -< x34 returnA -< x33 returnA -< x32 returnA -< x31 returnA -< x30 returnA -< x29 returnA -< x28 returnA -< x27 returnA -< x26 returnA -< x25 returnA -< x24 returnA -< x23 returnA -< x22 returnA -< x21 returnA -< x20 returnA -< x19 returnA -< x18 returnA -< x17 returnA -< x16 returnA -< x15 returnA -< x14 returnA -< x13 returnA -< x12 returnA -< x11 returnA -< x10 returnA -< x9 returnA -< x8 returnA -< x7 returnA -< x6 returnA -< x5 returnA -< x4 returnA -< x3 returnA -< x2 returnA -< x1 returnA -< x0
 ... ... @@ -7,7 +7,7 @@ import Data.Char f :: ArrowLoop a => a Char Int f = proc x -> do a <- returnA -< ord x rec b <- returnA -< ord c - ord x c <- returnA -< chr a returnA -< b + ord c a <- returnA -< ord x rec b <- returnA -< ord c - ord x c <- returnA -< chr a returnA -< b + ord c
 ... ... @@ -13,21 +13,21 @@ data Exp = Var Id | Add Exp Exp | If Exp Exp Exp | Lam Id Exp | App Exp Exp eval :: (ArrowChoice a, ArrowApply a) => Exp -> a [(Id, Val a)] (Val a) eval (Var s) = proc env -> returnA -< fromJust (lookup s env) returnA -< fromJust (lookup s env) eval (Add e1 e2) = proc env -> do ~(Num u) <- eval e1 -< env ~(Num v) <- eval e2 -< env returnA -< Num (u + v) ~(Num u) <- eval e1 -< env ~(Num v) <- eval e2 -< env returnA -< Num (u + v) eval (If e1 e2 e3) = proc env -> do ~(Bl b) <- eval e1 -< env if b then eval e2 -< env else eval e3 -< env ~(Bl b) <- eval e1 -< env if b then eval e2 -< env else eval e3 -< env eval (Lam x e) = proc env -> returnA -< Fun (proc v -> eval e -< (x,v):env) returnA -< Fun (proc v -> eval e -< (x,v):env) eval (App e1 e2) = proc env -> do ~(Fun f) <- eval e1 -< env v <- eval e2 -< env f -<< v ~(Fun f) <- eval e1 -< env v <- eval e2 -< env f -<< v -- some tests ... ... @@ -38,11 +38,11 @@ double = Lam "x" (Add (Var "x") (Var "x")) -- if b then k (double x) x else x + x + x text_exp = If (Var "b") (App (App k (App double (Var "x"))) (Var "x")) (Add (Var "x") (Add (Var "x") (Var "x"))) (App (App k (App double (Var "x"))) (Var "x")) (Add (Var "x") (Add (Var "x") (Var "x"))) unNum (Num n) = n main = do print (unNum (eval text_exp [("b", Bl True), ("x", Num 5)])) print (unNum (eval text_exp [("b", Bl False), ("x", Num 5)])) print (unNum (eval text_exp [("b", Bl True), ("x", Num 5)])) print (unNum (eval text_exp [("b", Bl False), ("x", Num 5)]))
 ... ... @@ -15,7 +15,7 @@ infixr 4 :&: -- or `powertrees' (cf Jayadev Misra's powerlists): data Pow a = Zero a | Succ (Pow (Pair a)) deriving Show deriving Show type Pair a = (a, a) ... ... @@ -33,7 +33,7 @@ tree3 = Succ (Succ (Succ (Zero (((1, 2), (3, 4)), ((5, 6), (7, 8)))))) -- in circuit design, eg Ruby, and descriptions of parallel algorithms.) -- And the type system will ensure that all legal programs preserve -- this structural invariant. -- -- -- The only problem is that the type constraint is too restrictive, rejecting -- many of the standard operations on these trees. Typically you want to -- split a tree into two subtrees, do some processing on the subtrees and ... ... @@ -56,13 +56,13 @@ apply (f :&: fs) (Succ t) = Succ (apply fs t) -- programming with Hom's. Firstly, Hom is an arrow: instance Category Hom where id = id :&: id (f :&: fs) . (g :&: gs) = (f . g) :&: (fs . gs) id = id :&: id (f :&: fs) . (g :&: gs) = (f . g) :&: (fs . gs) instance Arrow Hom where arr f = f :&: arr (f *** f) first (f :&: fs) = first f :&: (arr transpose >>> first fs >>> arr transpose) arr f = f :&: arr (f *** f) first (f :&: fs) = first f :&: (arr transpose >>> first fs >>> arr transpose) transpose :: ((a,b), (c,d)) -> ((a,c), (b,d)) transpose ((a,b), (c,d)) = ((a,c), (b,d)) ... ... @@ -70,7 +70,7 @@ transpose ((a,b), (c,d)) = ((a,c), (b,d)) -- arr maps f over the leaves of a powertree. -- The composition >>> composes sequences of functions pairwise. -- -- -- The *** operator unriffles a powertree of pairs into a pair of powertrees, -- applies the appropriate function to each and riffles the results. -- It defines a categorical product for this arrow category. ... ... @@ -85,9 +85,9 @@ transpose ((a,b), (c,d)) = ((a,c), (b,d)) butterfly :: (Pair a -> Pair a) -> Hom a a butterfly f = id :&: proc (x, y) -> do x' <- butterfly f -< x y' <- butterfly f -< y returnA -< f (x', y') x' <- butterfly f -< x y' <- butterfly f -< y returnA -< f (x', y') -- The recursive calls operate on halves of the original tree, so the -- recursion is well-defined. ... ... @@ -96,7 +96,7 @@ butterfly f = id :&: proc (x, y) -> do rev :: Hom a a rev = butterfly swap where swap (x, y) = (y, x) where swap (x, y) = (y, x) unriffle :: Hom (Pair a) (Pair a) unriffle = butterfly transpose ... ... @@ -105,26 +105,26 @@ unriffle = butterfly transpose bisort :: Ord a => Hom a a bisort = butterfly cmp where cmp (x, y) = (min x y, max x y) where cmp (x, y) = (min x y, max x y) -- This can be used (with rev) as the merge phase of a merge sort. -- -- sort :: Ord a => Hom a a sort = id :&: proc (x, y) -> do x' <- sort -< x y' <- sort -< y yr <- rev -< y' p <- unriffle -< (x', yr) bisort2 -< p where _ :&: bisort2 = bisort x' <- sort -< x y' <- sort -< y yr <- rev -< y' p <- unriffle -< (x', yr) bisort2 -< p where _ :&: bisort2 = bisort -- Here is the scan operation, using the algorithm of Ladner and Fischer: scan :: (a -> a -> a) -> a -> Hom a a scan op b = id :&: proc (x, y) -> do y' <- scan op b -< op x y l <- rsh b -< y' returnA -< (op l x, y') y' <- scan op b -< op x y l <- rsh b -< y' returnA -< (op l x, y') -- The auxiliary function rsh b shifts each element in the tree one place to -- the right, placing b in the now-vacant leftmost position, and discarding ... ... @@ -132,8 +132,8 @@ scan op b = id :&: proc (x, y) -> do rsh :: a -> Hom a a rsh b = const b :&: proc (x, y) -> do w <- rsh b -< y returnA -< (w, x) w <- rsh b -< y returnA -< (w, x) -- Finally, here is the Fast Fourier Transform: ... ... @@ -141,11 +141,11 @@ type C = Complex Double fft :: Hom C C fft = id :&: proc (x, y) -> do x' <- fft -< x y' <- fft -< y r <- roots (-1) -< () let z = r*y' unriffle -< (x' + z, x' - z) x' <- fft -< x y' <- fft -< y r <- roots (-1) -< () let z = r*y' unriffle -< (x' + z, x' - z) -- The auxiliary function roots r (where r is typically a root of unity) -- populates a tree of size n (necessarily a power of 2) with the values ... ... @@ -153,73 +153,73 @@ fft = id :&: proc (x, y) -> do roots :: C -> Hom () C roots r = const 1 :&: proc _ -> do x <- roots r' -< () unriffle -< (x, x*r') where r' = if imagPart s >= 0 then -s else s s = sqrt r x <- roots r' -< () unriffle -< (x, x*r') where r' = if imagPart s >= 0 then -s else s s = sqrt r -- Miscellaneous functions: rrot :: Hom a a rrot = id :&: proc (x, y) -> do w <- rrot -< y returnA -< (w, x) w <- rrot -< y returnA -< (w, x) ilv :: Hom a a -> Hom (Pair a) (Pair a) ilv f = proc (x, y) -> do x' <- f -< x y' <- f -< y returnA -< (x', y') x' <- f -< x y' <- f -< y returnA -< (x', y') scan' :: (a -> a -> a) -> a -> Hom a a scan' op b = proc x -> do l <- rsh b -< x (id :&: ilv (scan' op b)) -< op l x l <- rsh b -< x (id :&: ilv (scan' op b)) -< op l x riffle :: Hom (Pair a) (Pair a) riffle = id :&: proc ((x1, y1), (x2, y2)) -> do x <- riffle -< (x1, x2) y <- riffle -< (y1, y2) returnA -< (x, y) x <- riffle -< (x1, x2) y <- riffle -< (y1, y2) returnA -< (x, y) invert :: Hom a a invert = id :&: proc (x, y) -> do x' <- invert -< x y' <- invert -< y unriffle -< (x', y') x' <- invert -< x y' <- invert -< y unriffle -< (x', y')