diff --git a/LICENSE b/LICENSE
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2010, Yoshikuni Jujo
+Copyright (c) 2011, Yoshikuni Jujo
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
diff --git a/README b/README
new file mode 100644
--- /dev/null
+++ b/README
@@ -0,0 +1,7 @@
+implement Zot by Haskell
+
+Zot is purely functional language.
+Read here ( http://semarch.linguistics.fas.nyu.edu/barker/Iota/zot.html )
+
+Now, source cords are dirty.
+I will clean later.
diff --git a/src/AddEcho.hs b/src/AddEcho.hs
deleted file mode 100644
--- a/src/AddEcho.hs
+++ /dev/null
@@ -1,7 +0,0 @@
-module AddEcho ( main ) where
-
-import System.Environment
-
-main args = do
---	args <- getArgs
-	interact (++ concat args)
diff --git a/src/LambdaToSki.hs b/src/LambdaToSki.hs
--- a/src/LambdaToSki.hs
+++ b/src/LambdaToSki.hs
@@ -1,77 +1,81 @@
 module LambdaToSki ( main ) where
 
-import SKI ( mkski, Rec( .. ), fromInt, out, readChurch )
-import ReadLambda ( readLambda, showSKI )
+import Parse ( Parse, spot, token, eof, ( >*> ), alt, build, list1, recL1 )
+import Data.Char ( isLower, isAlphaNum )
 
 main :: IO ()
-main = interact lambdaToSKI
-
-fromLambda :: String -> Rec a
-fromLambda = mkski . showSKI . readLambda
-
-lambdaToSKI :: String -> String
-lambdaToSKI = showSKI . readLambda
-
-mulString = "\\x y -> x ( y ( \\g f xx -> f ( g f xx ) ) ) ( \\f x -> x )"
-
-mul :: Rec a -> Rec a -> Rec a
-mul x y = out ( out ( fromLambda mulString ) x ) y
+main = interact $ show . lambdaToSki . readLambda
 
-zero :: Rec a
-zero = fromLambda "\\f x -> x"
+data Lambda = Var String | Apply Lambda Lambda | Fun String Lambda | S | K | I
 
-suc :: Rec a -> Rec a
-suc = out ( fromLambda "\\g f x -> f ( g f x )" )
+instance Show Lambda where
+	show S			= "s"
+	show K			= "k"
+	show I			= "i"
+	show ( Apply f a )	= "`" ++ show f ++ show a
+	show ( Fun p e )	= "(fun " ++ p ++ " " ++ show e ++ ")"
+	show ( Var v )		= "(var " ++ v ++ ")"
 
-two = suc ( suc zero )
-three = suc two
+onlySKI :: Lambda -> Bool
+onlySKI S		= True
+onlySKI K		= True
+onlySKI I		= True
+onlySKI ( Apply f a )	= onlySKI f && onlySKI a
+onlySKI _		= False
 
-mul', zero', suc', two' :: String
-mul' = lambdaToSKI mulString
-zero' = lambdaToSKI "\\f x -> x"
-suc' = lambdaToSKI "\\g f x -> f ( g f x)"
-two' = apply suc' $ apply suc' zero'
-three' = apply suc' two'
+makeFun :: [ String ] -> Lambda -> Lambda
+makeFun [ p ] ex	= Fun p ex
+makeFun ( p : ps ) ex	= Fun p $ makeFun ps ex
+makeFun _ _		= error "makeFun error: need 1 parameter at least"
 
-apply :: String -> String -> String
-apply f a = '`' : f ++ a
+lambdaToSki :: Lambda -> Lambda
+lambdaToSki ( Fun x e )		= out x e
+lambdaToSki ( Apply f a )	= Apply ( lambdaToSki f ) ( lambdaToSki a )
+lambdaToSki _			= error "lambdaToSki error"
 
-cons, car, cdr :: String
-cons = "\\s b f -> f s b"
-car = "\\p -> p ( \\x y -> x )"
-cdr = "\\p -> p ( \\x y -> y )"
+out :: String -> Lambda -> Lambda
+out _ e
+	| onlySKI e	= Apply K e
+out x0 v@( Var x1 )
+	| x1 == x0	= I
+	| otherwise	= Apply K v
+out x0 ( Apply f a )	= Apply ( Apply S  $ out x0 f ) $ out x0 a
+out x0 ( Fun x1 e )
+	| x0 == x1	= Apply K $ out x0 e
+	| otherwise	= out x0 $ out x1 e
+out _ _			= error "never occur"
 
-true, false :: String
-true = "\\x y -> x"
-false = "\\x y -> y"
+readLambda :: String -> Lambda
+readLambda = fst . fst . head . ( parseLambda >*> eof ) . lexer
 
-getBool :: Rec a -> Bool
-getBool x = let Bool b = out ( out x ( Bool True ) ) ( Bool False ) in b
+parseLambda :: Parse String Lambda
+parseLambda = parseApply `alt` parseFun
 
-getIntList :: Rec a -> [ Int ]
-getIntList lst
---	| out ( out lst ( Bool True ) ) ( Bool False ) == Bool False	= [ ]
-	| isFalse lst							= [ ]
-	| otherwise							=
-		fromInt ( readChurch ( out lst ( fromLambda true ) ) ) :
-		getIntList ( out lst ( fromLambda false ) )
+parseApply :: Parse String Lambda
+parseApply = recL1 Apply parseAtom
 
-isFalse :: Rec a -> Bool
-isFalse ( In x )	= case x ( Bool True ) of
-	In y	-> y ( Bool False ) == Bool False
-	_	-> False
-isFalse _		= False
+parseFun :: Parse String Lambda
+parseFun = token "\\" >*> parseParams >*> token "->" >*> parseLambda
+	`build` ( \( "\\", ( ps, ( "->", e ) ) ) -> makeFun ps e )
 
-someList :: Rec a
-someList = mkski $ apply ( apply ( lambdaToSKI cons ) two' ) ( lambdaToSKI false )
+parseAtom :: Parse String Lambda
+parseAtom = ( spot ( isLower . head ) `build` Var ) `alt` parseParens
 
-makeIntList :: [ Int ] -> String
-makeIntList [ ]		= lambdaToSKI false
-makeIntList ( i : is )	=
-	apply ( apply ( lambdaToSKI cons ) $ makeChurch i ) $ makeIntList is
+parseParens :: Parse String Lambda
+parseParens = token "(" >*> parseLambda >*> token ")" `build` fst . snd
 
-makeChurch :: Int -> String
-makeChurch 0 = "`ki"
-makeChurch i = apply succ' $ makeChurch ( i - 1 )
+parseParams :: Parse String [ String ]
+parseParams = list1 $ spot $ isLower . head
 
-succ' = "`s``s`ks``s`kki"
+lexer :: String -> [ String ]
+lexer ""			= [ ]
+lexer ( ' ' : rest )		= lexer rest
+lexer ( '\n' : rest )		= lexer rest
+lexer ( '\\' : rest )		= "\\" : lexer rest
+lexer ( '-' : '>' : rest )	= "->" : lexer rest
+lexer ( '(' : rest )		= "(" : lexer rest
+lexer ( ')' : rest )		= ")" : lexer rest
+lexer ca@( c : _ )
+	| isLower c		= let ( ret, rest ) = span isAlphaNum ca in
+					ret : lexer rest
+lexer ca			= error $ "lexer error: " ++ ca
diff --git a/src/Parse.hs b/src/Parse.hs
--- a/src/Parse.hs
+++ b/src/Parse.hs
@@ -1,31 +1,35 @@
 module Parse (
 	Parse,
 	none,
+	succeed,
 	spot,
+	token,
+	tokens,
+	eof,
 	(>*>),
 	alt,
 	build,
-	token,
-	tokens,
-	recL1,
-	eof
+	list1,
+	recL1
 ) where
 
-infixr 8 >*>
-infix 7 `build`
+import Control.Arrow ( first, ( &&& ) )
 
+infixr	8 >*>
+infix	7 `build`
+infixl	6 `alt`
+
 type Parse a b = [ a ] -> [ ( b, [ a ] ) ]
 
 none :: Parse a b
-none _ = [ ]
+none = const [ ]
 
 succeed :: b -> Parse a b
-succeed val inp = [ ( val, inp ) ]
+succeed = curry ( : [] )
 
 spot :: ( a -> Bool ) -> Parse a a
-spot p ( x : xs )
-	| p x		= [ ( x, xs ) ]
-spot _ _		= [ ]
+spot p ( x : xs )	| p x	= [ ( x, xs ) ]
+spot _ _			= [ ]
 
 token :: Eq a => a -> Parse a a
 token = spot . ( == )
@@ -34,24 +38,25 @@
 tokens [ ]		= succeed [ ]
 tokens ( x : xs )	= token x >*> tokens xs `build` uncurry (:)
 
-alt :: Parse a b -> Parse a b -> Parse a b
-( p1 `alt` p2 ) inp = p1 inp ++ p2 inp
+eof :: Parse a ()
+eof [ ]	= [ ( (), [ ] ) ]
+eof _	= [ ]
 
 (>*>) :: Parse a b -> Parse a c -> Parse a ( b, c )
-( p1 >*> p2 ) inp =
-	[ ( ( y, z ), rem2 ) | ( y, rem1 ) <- p1 inp, ( z, rem2 ) <- p2 rem1 ]
+( p >*> q ) inp = [ ( ( x, y ), r' ) | ( x, r ) <- p inp, ( y, r' ) <- q r ]
 
+alt :: Parse a b -> Parse a b -> Parse a b
+p1 `alt` p2 = uncurry ( ++ ) . ( p1 &&& p2 )
+
 build :: Parse a b -> ( b -> c ) -> Parse a c
-build p f inp = [ ( f x, rem ) | ( x, rem ) <- p inp ]
+build p f = map ( first f ) . p
 
+list1 :: Parse a b -> Parse a [ b ]
+list1 p = p `build` ( : [] ) `alt` p >*> list1 p `build` uncurry ( : )
+
 recL1 :: ( b -> b -> b ) -> Parse a b -> Parse a b
 recL1 f p = ( p >*> recL1' f p ) `build` ( \( x, xs ) -> xs x )
 
 recL1' :: ( b -> c -> b ) -> Parse a c -> Parse a ( b -> b )
 recL1' f p = succeed id `alt`
-	( ( p >*> recL1' f p ) `build` ( \( x, xs ) ->
-		\y -> xs ( f y x ) ) )
-
-eof :: Parse a ()
-eof [ ]	= [ ( (), [ ] ) ]
-eof _	= [ ]
+	( p >*> recL1' f p `build` ( \( x, xs ) y -> xs ( f y x ) ) )
diff --git a/src/ReadLambda.hs b/src/ReadLambda.hs
deleted file mode 100644
--- a/src/ReadLambda.hs
+++ /dev/null
@@ -1,108 +0,0 @@
-module ReadLambda where
-
-import Parse
-import Data.Char
-
--- data SKI = S | K | I deriving Show
-
-data Lambda = Var String | Apply Lambda Lambda | Fun String Lambda
-	| S | K | I
-	deriving Show
-
-churchTwo :: Lambda
-churchTwo =
-	Fun "f" $ Fun "x" $ Apply ( Var "f" ) $ Apply ( Var "f" ) ( Var "x" )
-
-lambdaToSKI :: Lambda -> Lambda
-lambdaToSKI ( Fun x e ) = out x e
-lambdaToSKI ( Apply f a ) = Apply ( lambdaToSKI f ) ( lambdaToSKI a )
-lambdaToSKI nf = error $ "lambdaToSKI error: " ++ show nf
-
-onlySKI :: Lambda -> Bool
-onlySKI ( Fun _ _ )	= False
-onlySKI ( Var _ )	= False
-onlySKI ( Apply f a )	= onlySKI f && onlySKI a
-onlySKI S		= True
-onlySKI K		= True
-onlySKI I		= True
-
-notHave :: String -> Lambda -> Bool
-notHave x0 ( Var x1 )
-	| x0 == x1		= False
-	| otherwise		= True
-notHave x0 ( Fun _ e )		= notHave x0 e
-notHave x0 ( Apply f a )	= notHave x0 f && notHave x0 a
-notHave _ _			= True
-
-out :: String -> Lambda -> Lambda
-out x0 e
-	| onlySKI e	= Apply K $ e
-out x0 ( Var x1 )
-	| x1 == x0	= I
-	| otherwise	= Apply K $ Var x1
-{-
-out x0 ( Apply f ( Var x1 ) )
-	| x1 == x0 && notHave x0 f	= f
--}
-out x0 ( Apply f a )	= Apply ( Apply S  $ out x0 f ) $ out x0 a
-out x0 ( Fun x1 e )
-	| x0 == x1	= Apply K $ out x0 e
-	| otherwise	= ( out x0 ) $ out x1 e
-out x0 S		= Apply K S
-out x0 K		= Apply K K
-out x0 I		= Apply K I
--- out x0 ski		= Apply K $ ski
-
-showApply :: Lambda -> String
-showApply S = "s"
-showApply K = "k"
-showApply I = "i"
-showApply ( Apply f a ) = "`" ++ showApply f ++ showApply a
-showApply other = show other
-
-showSKI = showApply . lambdaToSKI
-
-readLambda :: String -> Lambda
-readLambda = fst . fst . head . ( parseLambda >*> eof ) . lexer
-
-parseLambda :: Parse String Lambda
-parseLambda = parseApply `alt` parseFun
-
-parseAtom :: Parse String Lambda
-parseAtom = ( spot ( isLower . head ) `build` Var ) `alt`
-	parseParens
-
-parseParens :: Parse String Lambda
-parseParens = ( token "(" >*> parseLambda >*> token ")" ) `build`
-	( \( "(", ( body, ")" ) ) -> body )
-
-parseApply :: Parse String Lambda
-parseApply = recL1 Apply parseAtom
-
-parseFun :: Parse String Lambda
-parseFun =
-	( token "\\" >*> parsePars >*> token "->" >*> parseLambda )
-		`build` ( \( "\\", ( vs, ( "->", e ) ) ) -> makeFun vs e )
-
-makeFun :: [ String ] -> Lambda -> Lambda
-makeFun [ p ] ex	= Fun p ex
-makeFun ( p : ps ) ex	= Fun p $ makeFun ps ex
-
-parsePars :: Parse String [ String ]
-parsePars = ( spot ( isLower . head ) `build` (:[]) ) `alt`
-	( ( spot ( isLower . head ) >*> parsePars ) `build`
-		( \( x, xs ) -> x : xs ) )
-
-lexer :: String -> [ String ]
-lexer "\n"			= [ ]
-lexer ""			= [ ]
-lexer ( '\\' : rest )		= "\\" : lexer rest
-lexer ( '-' : '>' : rest )	= "->" : lexer rest
-lexer ( ' ' : rest )		= lexer rest
-lexer ( '\n' : rest )		= lexer rest
-lexer ( '(' : rest )		= "(" : lexer rest
-lexer ( ')' : rest )		= ")" : lexer rest
-lexer ca@( c : _ )
-	| isLower c		= let ( ret, rest ) = span isAlphaNum ca in
-					ret : lexer rest
-lexer ca			= error $ "lexer error: " ++ ca
diff --git a/src/SKI.hs b/src/SKI.hs
--- a/src/SKI.hs
+++ b/src/SKI.hs
@@ -19,45 +19,53 @@
 	show _			= "function"
 
 suc :: Rec a
-suc = In sc
+suc = In scc
 	where
-	sc ( Int i )	= Int $ succ i
-	sc ( Char c )	= Char $ succ c
-	sc _		= error "not int"
+	scc ( Int i )	= Int $ succ i
+	scc ( Char c )	= Char $ succ c
+	scc _		= error "not int"
 
+out_ :: Rec a -> Rec a -> Rec a
 out_ x = case x of
 	In f	-> f
-	_	-> \y -> Error "not function"
+	_	-> \_ -> Error "not function"
 
 oi :: Rec a -> Rec a
 oi x = x
-i = In oi
+ii :: Rec a
+ii = In oi
 
 ok :: Rec a -> Rec a
 ok x = In $ \_ -> x
+k :: Rec a
 k = In ok
 
 os :: Rec a -> Rec a
 -- s x y z = x z ( y z )
 os x = In $ \y -> In $ \z -> ( out_ $ out_ x z ) ( out_ y z )
+s :: Rec a
 s = In os
 
 readChurch :: Rec a -> Rec a
-readChurch cn = cn `out_` suc `out_` ( Int 0 )
+readChurch cn = cn `out_` suc `out_` Int 0
 
+mkski :: String -> Rec a
 mkski = fst . makeSKI
 
 makeSKI :: String -> ( Rec a, String )
-makeSKI ( '`' : rest ) = let
-	( c, rest' ) = makeSKI rest
-	( c', rest'' ) = makeSKI rest' in case c of
+makeSKI ( '`' : rest )	= let
+	( c, rest' )	= makeSKI rest
+	( c', rest'' )	= makeSKI rest' in case c of
 		In f	-> ( f c', rest'' )
 		_	-> ( Error "in makeSKI", rest'' )
 --	( out c c', rest'' )
-makeSKI ( 's' : rest ) = ( s, rest )
-makeSKI ( 'k' : rest ) = ( k, rest )
-makeSKI ( 'i' : rest ) = ( i, rest )
+makeSKI ( 's' : rest )	= ( s, rest )
+makeSKI ( 'k' : rest )	= ( k, rest )
+makeSKI ( 'i' : rest )	= ( ii, rest )
+makeSKI _		= error "makeSKI error"
 
+sc :: Rec a
 sc = mkski "`s``s`ks``s`kki"
 
-mul x y = out ( out x ( out y sc ) ) ( out k i )
+mul :: Rec a -> Rec a -> Rec a
+mul x y = out ( out x ( out y sc ) ) ( out k ii )
diff --git a/src/SkiToLambda.hs b/src/SkiToLambda.hs
--- a/src/SkiToLambda.hs
+++ b/src/SkiToLambda.hs
@@ -1,112 +1,87 @@
 module SkiToLambda ( main ) where
 
-import System.Environment
-
-data Lambda = Var String | Apply Lambda Lambda | Fun String Lambda
-	deriving Show
-
-main :: [ String ] -> IO ()
-main args = do
---	( n : rest ) <- getArgs
-	let ( n : rest ) = args
-	case rest of
-		[ ]	-> interact $ ( ++ "\n" ) . showLambda . applyApp . applyI .
-			times ( read n ) apply . one . readSKI 0
-		[ "-h" ]	-> interact $ unlines . devide 80 . showLambdaTop . applyApp . applyI .
-			times ( read n ) apply . one . readSKI 0
-	where
-	one ( x, _, _ ) = x
-
-times :: Int -> ( a -> a ) -> a -> a
-times 0 _ x = x
-times n f x = times ( n - 1 ) f $ f x
-
-devide :: Int -> [ a ] -> [ [ a ] ]
-devide n [ ]	= [ ]
-devide n xs	= take n xs : devide n ( drop n xs )
-
-skiToLambda :: String -> String
-skiToLambda = fst . parens
-
-readSKI :: Int -> String -> ( Lambda, String, Int )
-readSKI n ( '`' : rest ) = let
-	( f, rest2, n2 ) = readSKI n rest
-	( a, rest3, n3 ) = readSKI n2 rest2 in
-	( Apply f a, rest3, n3 )
-readSKI n ( 'i' : rest ) = ( Fun x $ Var x, rest, n + 1 )
-	where	x = "x" ++ show n
-readSKI n ( 'k' : rest ) = ( Fun x $ Fun y $ Var x, rest, n + 1 )
-	where	x = "x" ++ show n
-		y = "y" ++ show n
-readSKI n ( 's' : rest ) = ( Fun x $ Fun y $ Fun z $
-	Apply ( Apply ( Var x ) ( Var z ) ) ( Apply ( Var y ) ( Var z ) ), rest, n +1 )
-	where	x = "x" ++ show n
-		y = "y" ++ show n
-		z = "z" ++ show n
-
-showLambda, showLambdaH, showLambdaApply, showLambdaFun :: Lambda -> String
-showLambda ( Var v ) = v
-showLambda ( Apply f a ) = "(" ++ showLambda f ++ " " ++ showLambda a ++ ")"
-showLambda ( Fun p e ) = "(\\" ++ p ++ " -> " ++ showLambda e ++ ")"
-
-showLambdaTop ( Apply f a )	= showLambdaApply f ++ " " ++ showLambdaH a
-showLambdaTop ( Fun p e )	= "\\" ++ p ++ showLambdaFun e
-showLambdaTop v			= showLambdaH v
+import Data.List ( minimumBy )
+import Data.Ord ( comparing )
+import Control.Arrow ( ( &&& ) )
 
-showLambdaH ( Var v ) = v
-showLambdaH ( Apply f a ) = "(" ++ showLambdaApply f ++ " " ++ showLambdaH a ++ ")"
-showLambdaH ( Fun p ( Var v ) )
-	| p == v	= "I"
-showLambdaH ( Fun p1 ( Fun p2 ( Var v ) ) )
-	| p1 == v	= "K"
-	| p2 == v	= "KI"
---	| otherwise	= "hoge"
-showLambdaH ( Fun p e ) = "(\\" ++ p ++ showLambdaFun e ++ ")"
+infixl 9 :$:
+infixr 8 :->
+data Lambda = Var String | Lambda :$: Lambda | String :-> Lambda | K | I
 
-showLambdaApply ( Apply f a )	= showLambdaApply f ++ " " ++ showLambdaH a
--- showLambdaApply ( Fun p e )	= "\\" ++ p ++ showLambdaFun e
-showLambdaApply e		= showLambdaH e
+instance Show Lambda where
+	show ( Var v )		= v
+	show ap@( _ :$: _ )	= showAp ap
+		where
+		showAp ( f :$: a )	= showAp f ++ " " ++ par show a
+		showAp e		= par show e
+		par sh a@( _ :$: _ )	= "(" ++ sh a ++ ")" 
+		par sh f@( _ :-> _ )	= "(" ++ sh f ++ ")"
+		par sh e		= sh e
+	show f@( _ :-> _ )		= '\\' : showFun f
+		where
+		showFun ( p :-> e )	= p ++ " " ++ showFun e
+		showFun e		= "-> " ++ show e
+	show K			= "K"
+	show I			= "I"
 
-showLambdaFun ( Fun p e )	= " " ++ p ++ showLambdaFun e
-showLambdaFun e			= " -> " ++ showLambdaApply e
+size :: Lambda -> Int
+size ( f :$: a )	= size f + size a
+size ( _ :-> e )	= 1 + size e
+size _			= 1
 
-parens :: String -> ( String, String )
-parens ( '`' : rest ) =	let
-	( f, rest2 ) = parens rest
-	( a, rest3 ) = parens rest2 in
-	( "(" ++ f ++ " " ++ a ++ ")", rest3 )
-parens ( c : rest ) = ( [ c ], rest )
+main :: [ String ] -> IO ()
+main args = interact $ case args of
+	[ ]		-> ( ++ "\n" ) . show . skiToLambda
+	[ "-h" ]	-> unlines . devide 80 . show . ki . skiToLambda
+	_		-> error "bad arguments"
+	where
+	devide _ [ ]	= [ ]
+	devide n xs	= take n xs : devide n ( drop n xs )
+	ki ( p :-> Var v )		| p == v	= I
+	ki ( p1 :-> p2 :-> Var v )	| p1 == v	= K
+					| p2 == v	= K :$: I
+	ki ( f :$: a )					= ki f :$: ki a
+	ki ( p :-> e )					= p :-> ki e
+	ki kiv						= kiv
 
-applyI :: Lambda -> Lambda
-applyI ( Apply ( Fun p ( Var v ) ) ar )
-	| p == v	= ar
-	| otherwise	= Var v
-applyI ( Apply ( Fun p1 ( Fun p2 ( Var v ) ) ) a )
-	| p2 == v	= Fun p2 ( Var v )
-	| p1 == v	= Fun p2 a
-applyI ( Apply f a )	= Apply ( applyI f ) $ applyI a
-applyI ( Fun p e )	= Fun p $ applyI e
-applyI ( Var v )	= Var v
+skiToLambda :: String -> Lambda
+skiToLambda = betaKI .
+	minimumBy ( comparing size ) . take 15 . iterate beta . fst . readSki 0
 
-applyApp :: Lambda -> Lambda
-applyApp ( Apply ( Fun p ( Apply ( Var v ) a ) ) f )
-	| p == v	= Apply f a
-applyApp ( Apply f a )	= Apply ( applyApp f ) $ applyApp a
-applyApp ( Fun p e )	= Fun p $ applyApp e
-applyApp ( Var v )	= Var v
+readSki :: Int -> String -> ( Lambda, ( Int, String ) )
+readSki n ( '`' : cs )	= let	( f, ncs )	= readSki n cs
+				( a, ncs' )	= uncurry readSki ncs in
+				( f :$: a, ncs' )
+readSki n ( c : cs )	= ( case c of
+	'i'	-> fx x
+	'k'	-> fx $ fy x
+	's'	-> fx $ fy $ fz $ x :$: z :$: ( y :$: z )
+	_	-> error "readSki error", ( n + 1, cs ) ) 
+	where
+	[ ( fx, x ), ( fy, y ), ( fz, z ) ] =
+		( ( ( :-> ) &&& Var ) . ( : show n ) ) `map` "xyz"
+readSki _ _		= error "readSki error"
 
-apply :: Lambda -> Lambda
-apply ( Apply fr ar ) =	case apply fr of
-	Fun p e -> applyPara p ( apply ar ) e
-	nf	-> Apply nf ( apply ar )
-apply ( Fun p e ) = Fun p ( apply e )
-apply ( Var v ) = Var v
+beta, betaKI :: Lambda -> Lambda
+beta ( fun :$: arg )	= case beta fun of
+	p :-> e	-> para p ( beta arg ) e
+	ex	-> ex :$: beta arg
+	where
+	para p a v@( Var x )	| p == x	= a
+				| otherwise	= v
+	para p a ( f :$: b )			= para p a f :$: para p a b
+	para p a f@( q :-> e )	| p == q	= f
+				| otherwise	= q :-> para p a e
+	para _ _ ki				= ki
+beta ( p :-> e )	= p :-> beta e
+beta kiv		= kiv
 
-applyPara :: String -> Lambda -> Lambda -> Lambda
-applyPara p a1 ( Var v )
-	| p == v		= a1
-	| otherwise		= Var v
-applyPara p a1 ( Apply f a2 )	= Apply ( applyPara p a1 f ) ( applyPara p a1 a2 )
-applyPara p1 a1 ( Fun p2 e )
-	| p1 == p2		= Fun p2 e
-	| otherwise		= Fun p2 $ applyPara p1 a1 e
+betaKI ( ( p :-> v@( Var x ) ) :$: ar )
+	| p == x	= ar
+	| otherwise	= v
+betaKI ( ( p :-> f@( q :-> Var x ) ) :$: a )
+	| q == x	= f
+	| p == x	= "_" :-> a
+betaKI ( f :$: a )	= betaKI f :$: betaKI a
+betaKI ( p :-> e )	= p :-> betaKI e
+betaKI kiv		= kiv
diff --git a/src/SkiToZot.hs b/src/SkiToZot.hs
--- a/src/SkiToZot.hs
+++ b/src/SkiToZot.hs
@@ -1,11 +1,13 @@
 module SkiToZot ( main ) where
 
+main :: IO ()
 main = interact skiToZot
 
 skiToZot :: String -> String
-skiToZot "\n"		= ""
-skiToZot ""		= ""
-skiToZot ( '`' : rest )	= '1' : skiToZot rest
-skiToZot ( 'i' : rest ) = "100" ++ skiToZot rest
-skiToZot ( 'k' : rest ) = "1010100" ++ skiToZot rest
-skiToZot ( 's' : rest ) = "101010100" ++ skiToZot rest
+skiToZot ""			= ""
+skiToZot ( '\n' : rest )	= skiToZot rest
+skiToZot ( '`' : rest )		= '1' : skiToZot rest
+skiToZot ( 'i' : rest ) 	= "100" ++ skiToZot rest
+skiToZot ( 'k' : rest ) 	= "1010100" ++ skiToZot rest
+skiToZot ( 's' : rest ) 	= "101010100" ++ skiToZot rest
+skiToZot _			= error "skiToZot error"
diff --git a/src/Zot.hs b/src/Zot.hs
--- a/src/Zot.hs
+++ b/src/Zot.hs
@@ -1,170 +1,83 @@
-{-# LANGUAGE PackageImports #-}
-
 module Zot ( main, mainFile ) where
 
-import "monads-tf" Control.Monad.State
-import Data.Char
+import Control.Monad ( foldM )
 
-data Fun = Fun { apply_ :: Fun -> IO Fun } | Int Int
+data Fun = Fun ( Fun -> IO Fun ) | Zero | One
 
-apply :: Fun -> Fun -> IO Fun
-apply ( Fun f )		= f
-apply ( Int int )	= apply i
+mkFun :: ( Fun -> Fun ) -> Fun
+mkFun f =  Fun $ return . f
 
 instance Show Fun where
-	show ( Int i )	= show i
-	show Fun{ }	= "function"
+	show Zero	= "0"
+	show One	= "1"
+	show ( Fun _ )	= "function"
+	showList fs	= ( concatMap show fs ++ )
 
-k, i :: Fun
-s = Fun $ \x -> return $ Fun $ \y -> return $ Fun $ \z -> do
-	xz <- apply x z
-	yz <- apply y z
-	apply xz yz
-k = Fun $ \x -> return $ Fun $ \y -> return x
-i = Fun return
+instance Read Fun where
+	readsPrec _ ( '0' : rest )	= [ ( Zero, rest ) ]
+	readsPrec _ ( '1' : rest )	= [ ( One, rest ) ]
+	readsPrec _ _			= error "read Fun failed"
+	readList str			= [ readl str ]
+		where
+		readl ""		= ( [ ], "" )
+		readl ( '0' : cs )	= let ( r, rest ) = readl cs in
+						( Zero : r, rest )
+		readl ( '1' : cs )	= let ( r, rest ) = readl cs in
+						( One : r, rest )
+		readl _			= error "read [ Fun ] failed"
 
-empty, zero, one :: Fun
-empty = Fun $ \c -> apply c i
-zero = Fun $ \c -> apply c $ Fun $ \f -> do
-	fs <- apply f s
-	apply fs k
-one = Fun $ \c -> return $ Fun $ \ll -> apply ll $
-	Fun $ \l -> return $ Fun $ \rr -> apply rr $ Fun $ \r -> do
-		lr <- apply l r
-		apply c lr
+( $$ ) :: Fun -> Fun -> IO Fun
+( $$ ) ( Fun f )	= f
+( $$ ) Zero		= ( zero $$ )
+( $$ ) One		= ( one $$ )
 
-remCom :: String -> String
-remCom = unlines . map ( takeWhile ( /= '#' ) ) . lines
+infixl 6 >$$
+( >$$ ) :: IO Fun -> Fun -> IO Fun
+f >$$ a = f >>= ( $$ a )
 
-main :: IO ()
-main = do
-	fun <- getContents >>= makeZot . filter ( not . isSpace ) . remCom
-	funOut <- apply fun =<< output
-	apply funOut pr
---	apply fun pr
-	putStrLn ""
+infixr 8 $$<
+( $$< ) :: Fun -> IO Fun -> IO Fun
+f $$< a = ( f $$ ) =<< a
 
-mainFile :: String -> IO ()
-mainFile fn = do
-	prg <- readFile fn
-	arg <- getContents
-	fun <- makeZot $ filter ( not . isSpace ) $ remCom $ prg ++ arg
-	funOut <- apply fun =<< output
-	apply funOut pr
-	putStrLn ""
+infixl 7 >$$<
+( >$$< ) :: IO Fun -> IO Fun -> IO Fun
+f >$$< a = f >>= ( $$< a )
 
-main_ :: IO ()
-main_ = do
-	apply i ( Int 3 ) >>= print
-	ii <- makeZot "100"
-	apply ii ( Int 3 ) >>= print
-	kkii <- makeZot "10100"
-	kkii4 <- apply kkii ( Int 4 )
-	print kkii4
-	apply kkii4 ( Int 7 ) >>= print
-	k8 <- apply k ( Int 8 )
-	apply k8 ( Int 3 ) >>= print
-	ki <- apply k i
-	ki3 <- apply ki ( Int 3 )
-	apply ki3 ( Int 5 ) >>= print
-	intOne <- interrogate =<< output
-	intOne0 <- apply intOne ( Int 0 )
-	intOne01 <- apply intOne0 ( Int 1 )
-	apply intOne01 ( Int 2 ) >>= print
-	pr1011
-	putStrLn ""
-	apply lst10 pr
-	putStrLn ""
-	rv <- makeZot $ rev ++ "1101000"
-	rvo <- apply rv =<< output
-	apply rvo pr
-	putStrLn ""
-	lst10f <- lst10''
-	apply lst10f pr
-	putStrLn ""
-	lst10f <- lst10'
---	lst10fo <- apply lst10f =<< output
-	apply lst10f pr
-	putStrLn ""
-	kif <- ioki
-	kif3 <- apply kif ( Int 3 )
-	apply kif3 ( Int 5 ) >>= print
+cont :: Fun -> Fun
+cont = Fun . flip ( $$ )
 
-($$) :: Fun -> Fun -> IO Fun
-f $$ a = apply f a
+s, k, i :: Fun
+s = mkFun $ \x -> mkFun $ \y -> Fun $ \z -> x $$ z >$$< y $$ z
+k = mkFun $ mkFun . const
+i = mkFun id
 
-makeZot :: String -> IO Fun
-makeZot "" = return $ empty
-makeZot bs = do
-	f <- makeZot $ init bs
-	apply f $ case last bs of
-		'1' -> one
-		'0' -> zero
+empty, zero, one :: Fun
+empty	= cont i
+zero	= cont $ Fun $ \f -> f $$ s >$$ k
+one	= mkFun $ \c -> cont $ mkFun $ \l -> cont $ Fun $ \r -> c $$< l $$ r
 
 pr :: Fun
-pr = Fun $ \x -> do
-	ix <- interrogate x
-	ix0 <- apply ix ( Int 0 )
-	apply ix0 ( Int 1 ) >>= putStr . show
-	return pr
-
-pr1011 :: IO Fun
-pr1011 = do
-	pr2 <- apply pr one
-	pr3 <- apply pr2 zero
-	pr4 <- apply pr3 one
-	apply pr4 one
-
-lst10 :: Fun
-lst10 = Fun $ \f -> do
---	( \g -> g zero )
-	f1 <- apply f one
-	apply f1 zero
-
-ioki :: IO Fun
-ioki = makeZot "110100100"
-
-iok1 :: IO Fun
-iok1 = makeZot "1101001"
+pr = Fun $ \x -> interrogate x >$$ Zero >$$ One >>= putStr . show >> return pr
 
-lst10' :: IO Fun
-lst10' = makeZot $ skiToZot "``s``si`k0`k1"
--- lst10' = makeZot $ skiToZot "``si`k1"
--- lst10' = makeZot "1 1 101010100 1 1 101010100 100 1 1010100 1 1 1010100 0"
--- lst10' = makeZot "11101010100100110101001"
+interrogate :: Fun -> IO Fun
+interrogate f = f $$ i >$$ i >$$ i >$$ k
 
-skiToZot :: String -> String
-skiToZot ""		= ""
-skiToZot ( '`' : rest )	= '1' : skiToZot rest
-skiToZot ( 's' : rest ) = "101010100" ++ skiToZot rest
-skiToZot ( 'k' : rest ) = "1010100" ++ skiToZot rest
-skiToZot ( 'i' : rest ) = "100" ++ skiToZot rest
-skiToZot ( '1' : rest ) = "1" ++ skiToZot rest
-skiToZot ( '0' : rest ) = "0" ++ skiToZot rest
+output :: IO Fun
+output = k $$< k $$< k $$< k $$< k $$< k $$ i
 
-lst10'' :: IO Fun
-lst10'' = do
-	si <- apply s i
-	k1 <- apply k one
-	k0 <- apply k zero
-	sik1 <- apply si k1
-	ssik1 <- apply s sik1
-	apply ssik1 k0
+readZot :: String -> IO Fun
+readZot = foldM ( $$ ) empty . read . filter ( `elem` "01" )
 
-interrogate :: Fun -> IO Fun
-interrogate f = do
-	fi <- apply f i
-	fii <- apply fi i
-	fiii <- apply fii i
-	apply fiii k
+interpret :: String -> IO ()
+interpret src = readZot ( removeComment src ) >$$< output >$$ pr >> putStrLn ""
+	where
+	removeComment = concatMap ( takeWhile ( /= '#' ) ) . lines
 
-output :: IO Fun
-output = do
-	ki <- apply k i
-	kki <- apply k ki
-	kkki <- apply k kki
-	kkkki <- apply k kkki
-	kkkkki <- apply k kkkki
-	apply k kkkkki
+main :: IO ()
+main = getContents >>= interpret
 
-rev = "1111010101001110101010010011010100100100111010101001110101010011010100101010100111010101001101010011010101001101010010101010011101010100111010101001101010010101010011101010100110101001101010100110101001010101001110101010011010100110101010011010100110101010011101010100111010101001110101010011101010100100110101001001101010010011010100100110101001010100111010101001101010011010101001101010011010101001101010010101001110101010011101010100110101001010101001110101010011010100110101010011010100101010100111010101001101010011010101001110101010011010100101010100101010011101010100110101001010100111010101001110101010011010100101010100111010101001101010010101001110101010011010100101010100101010011010100111010101001101010011010101001001010100110101001010100111010101001101010011010101001101010011010101001101010010101001110101010011101010100110101001010101001110101010011010100110101010011010100101010100111010101001101010011010101001110101010011010100101010100101010011101010100110101001010100111010101001110101010011010100101010100111010101001101010010101001110101010011010100101010100101010011010100111010101001101010011010101001001010100110101001010100111010101001101010010101001010100"
+mainFile :: String -> IO ()
+mainFile fn = do
+	prg <- readFile fn
+	arg <- getContents
+	interpret $ prg ++ arg
diff --git a/src/ZotToSki.hs b/src/ZotToSki.hs
--- a/src/ZotToSki.hs
+++ b/src/ZotToSki.hs
@@ -1,41 +1,21 @@
 module ZotToSki ( main ) where
 
-import Parse
-
-rev = "1111010101001110101010010011010100100100111010101001110101010011010100101010100111010101001101010011010101001101010010101010011101010100111010101001101010010101010011101010100110101001101010100110101001010101001110101010011010100110101010011010100110101010011101010100111010101001110101010011101010100100110101001001101010010011010100100110101001010100111010101001101010011010101001101010011010101001101010010101001110101010011101010100110101001010101001110101010011010100110101010011010100101010100111010101001101010011010101001110101010011010100101010100101010011101010100110101001010100111010101001110101010011010100101010100111010101001101010010101001110101010011010100101010100101010011010100111010101001101010011010101001001010100110101001010100111010101001101010011010101001101010011010101001101010010101001110101010011101010100110101001010101001110101010011010100110101010011010100101010100111010101001101010011010101001110101010011010100101010100101010011101010100110101001010100111010101001110101010011010100101010100111010101001101010010101001110101010011010100101010100101010011010100111010101001101010011010101001001010100110101001010100111010101001101010010101001010100"
-
-test = "11010101001010100"
+import Parse ( Parse, token, tokens, ( >*> ), alt, build, eof )
 
--- main = putStrLn $ zotToSKI $ ( replicate 1 '1' ++ ) $ concat $ replicate 2 rev
+main :: IO ()
 main = interact $ zotToSKI . concat . lines
 
-shortest :: [ [ a ] ] -> [ a ]
-shortest [ ] = [ ]
-shortest [ l ] = l
-shortest ( l : ls )
-	| length l < length ( shortest ls )	= l
-	| otherwise				= shortest ls
-
 zotToSKI :: String -> String
-zotToSKI = head . {- shortest {- head -} . -} map fst . ( parseZot >*> eof `build` fst )
+zotToSKI = fst . head . ( parseZot >*> eof `build` fst )
 
 parseZot :: Parse Char String
-parseZot = parseApply `alt` parseSKI -- `alt` parse10
+parseZot = parseApply `alt` parseS `alt` parseK `alt` parseI
 
 parseApply :: Parse Char String
 parseApply = token '1' >*> parseZot >*> parseZot `build`
 	\( _, ( ski1, ski2 ) ) -> '`' : ski1 ++ ski2
 
-parseSKI, parse10 :: Parse Char String
-parseSKI = parseI `alt` parseK `alt` parseS
-parse10 = parse1 `alt` parse0
-	
-parseI, parseK, parseS :: Parse Char String
-parseI = tokens "100" `build` const "i"
-parseKI = tokens "10100" `build` const "ki"
-parseK = tokens "1010100" `build` const "k"
+parseS, parseK, parseI :: Parse Char String
 parseS = tokens "101010100" `build` const "s"
-
-parse1, parse0 :: Parse Char String
-parse1 = token '1' `build` const "1"
-parse0 = token '0' `build` const "0"
+parseK = tokens "1010100" `build` const "k"
+parseI = tokens "100" `build` const "i"
diff --git a/src/zot.hs b/src/zot.hs
--- a/src/zot.hs
+++ b/src/zot.hs
@@ -1,23 +1,25 @@
 module Main where
 
-import qualified Zot
-import qualified LambdaToSki
-import qualified SkiToLambda
-import qualified SkiToZot
-import qualified ZotToSki
-import qualified AddEcho
+import qualified Zot		( main, mainFile )
+import qualified SkiToZot	( main )
+import qualified ZotToSki	( main )
+import qualified LambdaToSki	( main )
+import qualified SkiToLambda	( main )
 
 import System.Environment ( getArgs )
 import Data.List ( isSuffixOf )
 
 main :: IO ()
 main = do
-	cmd : args <- getArgs
-	case cmd of
-		"-"					-> Zot.main
-		"lambdaToSki"				-> LambdaToSki.main
-		"skiToLambda"				-> SkiToLambda.main args
-		"skiToZot"				-> SkiToZot.main
-		"zotToSki"				-> ZotToSki.main
-		"arg"					-> AddEcho.main args
-		_	| ".zot" `isSuffixOf` cmd	-> Zot.mainFile cmd
+	ca@( ~( cmd : args ) ) <- getArgs
+	let command = if null ca then "" else cmd
+	case command of
+		"skiToZot"	-> SkiToZot.main
+		"zotToSki"	-> ZotToSki.main
+		"lambdaToSki"	-> LambdaToSki.main
+		"skiToLambda"	-> SkiToLambda.main args
+		"arg"		-> interact (++ concat args )
+		"-"		-> Zot.main
+		_
+			| ".zot" `isSuffixOf` command	-> Zot.mainFile command
+			| otherwise			-> error "bad arguments"
diff --git a/zot.cabal b/zot.cabal
--- a/zot.cabal
+++ b/zot.cabal
@@ -2,7 +2,7 @@
 cabal-version:	>= 1.6
 
 name:		zot
-version:	0.0.1
+version:	0.0.2
 stability:	experimental
 author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp>
 maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>
@@ -13,7 +13,7 @@
 category:	Language
 synopsis:	Zot language
 description:
-  Zot language
+  Zot language ( http://semarch.linguistics.fas.nyu.edu/barker/Iota/zot.html )
   .
   > echo "10100" | cat examples/reverse.zot - | zot -
   > 00101
@@ -23,13 +23,13 @@
   .
   And try
   .
-  > cat examples/reverse.zot | zot zotToSki | zot skiToLambda 3
+  > cat examples/reverse.zot | zot zotToSki | zot skiToLambda
   .
   and
   .
-  > cat examples/reverse.zot | zot zotToSki | zot skiToLambda 3 -h
+  > cat examples/reverse.zot | zot zotToSki | zot skiToLambda -h
 
-data-files:	examples/reverse.lambda, examples/reverse.zot
+data-files:	examples/reverse.lambda, examples/reverse.zot, README
 
 source-repository	head
   type:		git
@@ -38,5 +38,6 @@
 executable	zot
   hs-source-dirs:	src
   main-is:		zot.hs
-  other-modules:	Zot, LambdaToSki, SkiToLambda, SkiToZot, ZotToSki, AddEcho, Parse, ReadLambda, SKI
+  other-modules:	Zot, LambdaToSki, SkiToLambda, SkiToZot, ZotToSki, Parse, SKI
   build-depends:	base > 3 && < 5, monads-tf
+  ghc-options:		-Wall