<br />
<b>Deprecated</b>:  The each() function is deprecated. This message will be suppressed on further calls in <b>/home/zhenxiangba/zhenxiangba.com/public_html/phproxy-improved-master/index.php</b> on line <b>456</b><br />
-- different list functions recursively and as foldrs

{-
foldr :: (a -> b -> b) -> b -> [a] -> b
foldr c n [] = n
foldr c n (a : as) = c a (foldr c n as) 
-}

myConcat :: [[a]] -> [a]
{-
myConcat [] = []
myConcat (as : ass) = as ++ myConcat ass
-}
myConcat = foldr (++) []

myElem :: Eq a => a -> [a] -> Bool
{-
myElem e [] = False
myElem e (a : as) = if e == a then True else myElem e as
-}
myElem e = foldr (\ a b -> if e == a then True else b) False

nth :: [a] -> Int -> a
{-
nth (a : as) n =  if n == 0 then a else nth as (n - 1)
-}

nth = foldr (\ a f n -> if n == 0 then a else f (n - 1)) 
                                            (\ _ -> error "bad case")


-- Eratosthenes' sieve

sieve :: [Int]
sieve = sieve' [2..]

sieve' :: [Int] -> [Int]
sieve' (n : ns) = n : sieve' [ m | m <- ns , m `mod` n /= 0 ]


-- cf this non-recursive protosieve

protosieve (n : ns) = n : [ m | m <- ns, m `mod` n /= 0 ]

--protosieve (n : ns) = n : filter (\ m -> m `mod` n /= 0) ns


-- defining types

-- some simple non-recursive datatypes

-- data Bool = True | False

data Answer = Yes | No | Unknown

flip :: Answer -> Answer
flip Yes     = No
flip No      = Yes
flip Unknown = Unknown


data Shape = Circle Float | Rect Float Float

square :: Float -> Shape
square n = Rect n n

area :: Shape -> Float
area (Circle r) = pi * r ^ 2
area (Rect x y) = x * y


-- maybe types

{-
data Maybe a = Nothing | Just a
-}

{-
return :: a -> Maybe a
return a = Just a

(>>=) :: Maybe a -> (a -> Maybe b) -> Maybe b
Nothing >>= _ = Nothing
Just a  >>= f = f a
-}


{-
class Monad m where
  return :: a -> m a
  (>>=) :: m a -> (a -> m b) -> m b

instance Monad Maybe where
  return a = Just a
  Nothing >>= _ = Nothing
  Just a  >>= f = f a
-}


-- further to some recursive datatypes

-- (unary) natural numbers


data Nat = Zero | Succ Nat

nat2int :: Nat -> Int
nat2int Zero     = 0
nat2int (Succ n) = 1 + nat2int n

int2nat :: Int -> Nat
int2nat 0     = Zero
int2nat (i+1) = Succ (int2nat i)


addN :: Nat -> Nat -> Nat
addN Zero n = n
addN (Succ m) n = Succ (addN m n)

multN :: Nat -> Nat -> Nat
multN Zero n = Zero
multN (Succ m) n = addN m (multN m n)

foldN :: (b -> b) -> b -> Nat -> b
foldN s z Zero = z
foldN s z (Succ n) = s (foldN s z n)


{-
-- alternatively, naturals can be used as a type synonym

type Nat = [()]

zero :: Nat
zero = []

suck :: Nat -> Nat
suck n = () : n

addNat = (++)
-} 


-- binary naturals

data Bin = B0 Bin | B1 Bin | Null

--type Bin = [Bool]

bin2int :: Bin -> Int
bin2int n = fst (bin2int' n)

bin2int' :: Bin -> (Int, Int)
bin2int' Null = (0, 0)
bin2int' (B0 n) = (n', ell + 1)
                    where (n', ell) = bin2int' n
bin2int' (B1 n) = (2 ^ ell + n', ell + 1)
                   where (n', ell) = bin2int' n

-- think of further functions for binary naturals

-- base-n naturals 


-- arithmetic expressions

-- variable environments

{-
type Env = [(String, Int)]

lkp :: String -> Env -> Maybe Int
lkp x [] = Nothing
lkp x ((x',n) : xs) = if x == x' then Just n else lkp x xs

empty :: Env
empty = []

update :: String -> Int -> Env -> Env
update x n xs = (x, n) : xs
-}

type Env = String -> Maybe Int

lkp :: String -> Env -> Maybe Int
lkp x env = env x

empty :: Env
empty _ = Nothing

update :: String -> Int -> Env -> Env
update x n env = env' 
        where env' y | x == y = Just n
                     | otherwise = env y


-- expressions

data Expr = Var String 
            | Num Int
            | Add Expr Expr
            | Mul Expr Expr deriving Show


size :: Expr -> Int
size (Num n) = 1
size (Add e0 e1) = 1 + size e0 + size e1
size (Mul e0 e1) = 1 + size e0 + size e1


eval :: Expr -> Env -> Maybe Int
eval (Var x) env = lkp x env
eval (Num n) env = Just n
eval (Add e0 e1) env = case eval e0 env of 
                       Nothing -> Nothing
                       Just n0 -> case eval e1 env of
                         Nothing -> Nothing
                         Just n1 -> Just (n0 + n1) 
eval (Mul e0 e1) env = case eval e0 env of 
                       Nothing -> Nothing
                       Just n0 -> if n0 == 0 then Just 0 else case eval e1 env of
                         Nothing -> Nothing
                         Just n1 -> Just (n0 * n1)


mulUp n = Mul (Num n) (mulUp (n+1)) 


-- define fold for this recursive datatype


-- example of non-structural recursion


gcd m n = if m >= n then gcd' m n else gcd' n m

gcd' m n = if m `mod` n == 0 then n else gcd' n (m `mod` n)


-- some basic type classes

{-
class Functor f where
    fmap :: (a -> b) -> (f a -> f b)

class Monad m where
    return :: a -> m a
    (>>=)  :: m a -> (a -> m b) -> m b
    (>>)   :: m a -> m b -> m b
    fail   :: String -> m a

    -- Minimal complete definition: (>>=), return
    p >> q  = p >>= \ _ -> q
    fail s  = error s
-}