summaryrefslogtreecommitdiff
path: root/SmallRing.hs
blob: f710393a8a8600b98257c20318db9cd607838333 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
{-# LANGUAGE RankNTypes #-}
module SmallRing where

import Data.Ratio

odds :: (Integral i, Num a) => i -> [a]
odds x = [ 1 + 2 * fromIntegral n | n <- [0..x] ]

pts :: (Fractional a, Integral b) => b -> [a]
pts i = let d = 2^i in [ k / d | k <- odds (2^(i-1) - 1) ]

fractions :: Fractional b => [b]
fractions = concatMap pts [1..]

vis :: Int -> Ratio Int -> [Char]
vis w α = let i = numerator α
              n = denominator α
              x = (w * i) `div` n
           in replicate (x-1) '.' ++ "x" ++ replicate (w-max x 1) '.' ++ show α

data Giver a
    = Give0
    | Give1 (forall b. (a -> b) -> b)
    | Give2 (forall b. (a -> a -> b) -> b)
    | Give3 (forall b. (a -> a -> a -> b) -> b)

pushFront :: a -> Giver a -> Giver a
pushFront a Give0     = Give1 ($ a)
pushFront a (Give1 f) = Give2 (\g -> f (g a))
pushFront a (Give2 f) = Give3 (\g -> f (g a))
pushFront a (Give3 f) = f $ \b c _ -> Give3 $ \g -> g a b c

front :: Giver a -> Maybe a
front Give0     = Nothing
front (Give1 f) = f Just
front (Give2 g) = g (\x _ -> Just x)
front (Give3 h) = h (\x _ _ -> Just x)

take3 :: (a -> a -> a -> b) -> Giver a -> Maybe b
take3 f (Give3 g) = Just (g f)
take3 _ _         = Nothing

with3 :: Applicative f => Giver a -> (a -> a -> a -> f ()) -> f ()
with3 (Give3 g) f = g f
with3 _ _         = pure ()