Ticket #2814: test.hs

File test.hs, 845 bytes (added by celes, 7 years ago)

original program

Line 
1import System
2import Char
3
4data V = Fun (V -> V)
5       | Val Int
6       | Str String
7
8app :: V -> V -> V
9app (Fun f) v = f v
10
11unchurch :: V -> Int
12unchurch c = i where
13        Val i = c `app` Fun inc `app` Val 0
14        inc (Val x) = Val (x+1)
15church i = Fun (\f -> Fun (\x -> iterate (app f) x !! i))
16
17-- \l . l (\a b i.unchurch a : unlist b) ""
18unlist :: V -> String
19unlist l = s where Str s = unlist' l
20unlist' :: V -> V
21unlist' l = l `app` Fun walk `app` Str "" where
22        walk a = Fun (\b -> Fun (\i-> Str (chr (unchurch a) : unlist b)))
23
24cons a b = Fun (\x -> x `app` a `app` b)
25nil = Fun (\a -> Fun (\b -> b) )
26tolist "" = nil
27tolist (x:xs) = cons (church (ord x)) (tolist xs)
28
29main= interact (\i->unlist (((Fun (\v0 -> (v0 `app` v0)) `app` Fun (\v0 -> (v0 `app` v0))) `app` (Fun (\v0 -> (v0 `app` v0)) `app` Fun (\v0 -> (v0 `app` v0)))) `app` tolist i))