packages feed

zot (empty) → 0.0.1

raw patch · 15 files changed

+776/−0 lines, 15 filesdep +basedep +monads-tfsetup-changed

Dependencies added: base, monads-tf

Files

+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (c) 2010, Yoshikuni Jujo+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++  * Redistributions of source code must retain the above copyright notice,+    this list of conditions and the following disclaimer.++  * Redistributions in binary form must reproduce the above copyright+    notice, this list of conditions and the following disclaimer in the+    documentation and/or other materials provided with the distribution.++  * Neither the name of the Yoshikuni Jujo nor the names of its+    contributors may be used to endorse or promote products derived from+    this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"+AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE+ARE DISCLAIMED. IN NO EVEN SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE+FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR+SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER+CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,+OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ examples/reverse.lambda view
@@ -0,0 +1,6 @@+\c -> ( \x -> c ( \x -> x ) ( \x -> x ) ( \x -> x ) ( \x -> \y -> x ) x x ( \x -> x ) )+( \ignore ->+( \y -> y ( \p -> p c ) y ) ( \r s c -> c ( \x -> x ) ( \x -> x ) ( \x -> x )+( \x -> \y -> x )+( \ignore -> s ( \p -> r ( p c ) ) s )+( \ignore -> s ( \p -> r ( p c ) ) s ) r ) )
+ examples/reverse.zot view
@@ -0,0 +1,30 @@+1111010101001110101010010011010100100100+1110101010011101010100110101001010101001+1101010100110101001101010100110101001010+1010011101010100111010101001101010010101+0100111010101001101010011010101001101010+0101010100111010101001101010011010101001+1010100110101010011101010100111010101001+1101010100111010101001001101010010011010+1001001101010010011010100101010011101010+1001101010011010101001101010011010101001+1010100101010011101010100111010101001101+0100101010100111010101001101010011010101+0011010100101010100111010101001101010011+0101010011101010100110101001010101001010+1001110101010011010100101010011101010100+1110101010011010100101010100111010101001+1010100101010011101010100110101001010101+0010101001101010011101010100110101001101+0101001001010100110101001010100111010101+0011010100110101010011010100110101010011+0101001010100111010101001110101010011010+1001010101001110101010011010100110101010+0110101001010101001110101010011010100110+1010100111010101001101010010101010010101+0011101010100110101001010100111010101001+1101010100110101001010101001110101010011+0101001010100111010101001101010010101010+0101010011010100111010101001101010011010+1010010010101001101010010101001110101010+01101010010101001010100
+ src/AddEcho.hs view
@@ -0,0 +1,7 @@+module AddEcho ( main ) where++import System.Environment++main args = do+--	args <- getArgs+	interact (++ concat args)
+ src/LambdaToSki.hs view
@@ -0,0 +1,77 @@+module LambdaToSki ( main ) where++import SKI ( mkski, Rec( .. ), fromInt, out, readChurch )+import ReadLambda ( readLambda, showSKI )++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++zero :: Rec a+zero = fromLambda "\\f x -> x"++suc :: Rec a -> Rec a+suc = out ( fromLambda "\\g f x -> f ( g f x )" )++two = suc ( suc zero )+three = suc two++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'++apply :: String -> String -> String+apply f a = '`' : f ++ a++cons, car, cdr :: String+cons = "\\s b f -> f s b"+car = "\\p -> p ( \\x y -> x )"+cdr = "\\p -> p ( \\x y -> y )"++true, false :: String+true = "\\x y -> x"+false = "\\x y -> y"++getBool :: Rec a -> Bool+getBool x = let Bool b = out ( out x ( Bool True ) ) ( Bool False ) in b++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 ) )++isFalse :: Rec a -> Bool+isFalse ( In x )	= case x ( Bool True ) of+	In y	-> y ( Bool False ) == Bool False+	_	-> False+isFalse _		= False++someList :: Rec a+someList = mkski $ apply ( apply ( lambdaToSKI cons ) two' ) ( lambdaToSKI false )++makeIntList :: [ Int ] -> String+makeIntList [ ]		= lambdaToSKI false+makeIntList ( i : is )	=+	apply ( apply ( lambdaToSKI cons ) $ makeChurch i ) $ makeIntList is++makeChurch :: Int -> String+makeChurch 0 = "`ki"+makeChurch i = apply succ' $ makeChurch ( i - 1 )++succ' = "`s``s`ks``s`kki"
+ src/Parse.hs view
@@ -0,0 +1,57 @@+module Parse (+	Parse,+	none,+	spot,+	(>*>),+	alt,+	build,+	token,+	tokens,+	recL1,+	eof+) where++infixr 8 >*>+infix 7 `build`++type Parse a b = [ a ] -> [ ( b, [ a ] ) ]++none :: Parse a b+none _ = [ ]++succeed :: b -> Parse a b+succeed val inp = [ ( val, inp ) ]++spot :: ( a -> Bool ) -> Parse a a+spot p ( x : xs )+	| p x		= [ ( x, xs ) ]+spot _ _		= [ ]++token :: Eq a => a -> Parse a a+token = spot . ( == )++tokens :: Eq a => [ a ] -> Parse a [ a ]+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++(>*>) :: Parse a b -> Parse a c -> Parse a ( b, c )+( p1 >*> p2 ) inp =+	[ ( ( y, z ), rem2 ) | ( y, rem1 ) <- p1 inp, ( z, rem2 ) <- p2 rem1 ]++build :: Parse a b -> ( b -> c ) -> Parse a c+build p f inp = [ ( f x, rem ) | ( x, rem ) <- p inp ]++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 _	= [ ]
+ src/ReadLambda.hs view
@@ -0,0 +1,108 @@+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
+ src/SKI.hs view
@@ -0,0 +1,63 @@+module SKI where++data Rec a+	= In { out :: Rec a -> Rec a }+	| Int { fromInt :: Int }+	| Char Char | Bool Bool+	| Error String++instance Eq ( Rec a ) where+	Int i == Int j		= i == j+	Char c == Char d	= c == d+	Bool b == Bool c	= b == c+	In _ == In _		= error "can not compare"+	_ == _			= False++instance Show ( Rec a ) where+	show ( Int i )		= show i+	show ( Error e )	= "Error: " ++ e+	show _			= "function"++suc :: Rec a+suc = In sc+	where+	sc ( Int i )	= Int $ succ i+	sc ( Char c )	= Char $ succ c+	sc _		= error "not int"++out_ x = case x of+	In f	-> f+	_	-> \y -> Error "not function"++oi :: Rec a -> Rec a+oi x = x+i = In oi++ok :: Rec a -> Rec a+ok x = In $ \_ -> x+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 = In os++readChurch :: Rec a -> Rec a+readChurch cn = cn `out_` suc `out_` ( Int 0 )++mkski = fst . makeSKI++makeSKI :: String -> ( Rec a, String )+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 )++sc = mkski "`s``s`ks``s`kki"++mul x y = out ( out x ( out y sc ) ) ( out k i )
+ src/SkiToLambda.hs view
@@ -0,0 +1,112 @@+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++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 ++ ")"++showLambdaApply ( Apply f a )	= showLambdaApply f ++ " " ++ showLambdaH a+-- showLambdaApply ( Fun p e )	= "\\" ++ p ++ showLambdaFun e+showLambdaApply e		= showLambdaH e++showLambdaFun ( Fun p e )	= " " ++ p ++ showLambdaFun e+showLambdaFun e			= " -> " ++ showLambdaApply e++parens :: String -> ( String, String )+parens ( '`' : rest ) =	let+	( f, rest2 ) = parens rest+	( a, rest3 ) = parens rest2 in+	( "(" ++ f ++ " " ++ a ++ ")", rest3 )+parens ( c : rest ) = ( [ c ], rest )++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++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++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++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
+ src/SkiToZot.hs view
@@ -0,0 +1,11 @@+module SkiToZot ( main ) where++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
+ src/Zot.hs view
@@ -0,0 +1,170 @@+{-# LANGUAGE PackageImports #-}++module Zot ( main, mainFile ) where++import "monads-tf" Control.Monad.State+import Data.Char++data Fun = Fun { apply_ :: Fun -> IO Fun } | Int Int++apply :: Fun -> Fun -> IO Fun+apply ( Fun f )		= f+apply ( Int int )	= apply i++instance Show Fun where+	show ( Int i )	= show i+	show Fun{ }	= "function"++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++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++remCom :: String -> String+remCom = unlines . map ( takeWhile ( /= '#' ) ) . lines++main :: IO ()+main = do+	fun <- getContents >>= makeZot . filter ( not . isSpace ) . remCom+	funOut <- apply fun =<< output+	apply funOut pr+--	apply fun pr+	putStrLn ""++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 ""++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++($$) :: Fun -> Fun -> IO Fun+f $$ a = apply f a++makeZot :: String -> IO Fun+makeZot "" = return $ empty+makeZot bs = do+	f <- makeZot $ init bs+	apply f $ case last bs of+		'1' -> one+		'0' -> zero++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"++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"++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++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++interrogate :: Fun -> IO Fun+interrogate f = do+	fi <- apply f i+	fii <- apply fi i+	fiii <- apply fii i+	apply fiii k++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++rev = "1111010101001110101010010011010100100100111010101001110101010011010100101010100111010101001101010011010101001101010010101010011101010100111010101001101010010101010011101010100110101001101010100110101001010101001110101010011010100110101010011010100110101010011101010100111010101001110101010011101010100100110101001001101010010011010100100110101001010100111010101001101010011010101001101010011010101001101010010101001110101010011101010100110101001010101001110101010011010100110101010011010100101010100111010101001101010011010101001110101010011010100101010100101010011101010100110101001010100111010101001110101010011010100101010100111010101001101010010101001110101010011010100101010100101010011010100111010101001101010011010101001001010100110101001010100111010101001101010011010101001101010011010101001101010010101001110101010011101010100110101001010101001110101010011010100110101010011010100101010100111010101001101010011010101001110101010011010100101010100101010011101010100110101001010100111010101001110101010011010100101010100111010101001101010010101001110101010011010100101010100101010011010100111010101001101010011010101001001010100110101001010100111010101001101010010101001010100"
+ src/ZotToSki.hs view
@@ -0,0 +1,41 @@+module ZotToSki ( main ) where++import Parse++rev = "1111010101001110101010010011010100100100111010101001110101010011010100101010100111010101001101010011010101001101010010101010011101010100111010101001101010010101010011101010100110101001101010100110101001010101001110101010011010100110101010011010100110101010011101010100111010101001110101010011101010100100110101001001101010010011010100100110101001010100111010101001101010011010101001101010011010101001101010010101001110101010011101010100110101001010101001110101010011010100110101010011010100101010100111010101001101010011010101001110101010011010100101010100101010011101010100110101001010100111010101001110101010011010100101010100111010101001101010010101001110101010011010100101010100101010011010100111010101001101010011010101001001010100110101001010100111010101001101010011010101001101010011010101001101010010101001110101010011101010100110101001010101001110101010011010100110101010011010100101010100111010101001101010011010101001110101010011010100101010100101010011101010100110101001010100111010101001110101010011010100101010100111010101001101010010101001110101010011010100101010100101010011010100111010101001101010011010101001001010100110101001010100111010101001101010010101001010100"++test = "11010101001010100"++-- main = putStrLn $ zotToSKI $ ( replicate 1 '1' ++ ) $ concat $ replicate 2 rev+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 )++parseZot :: Parse Char String+parseZot = parseApply `alt` parseSKI -- `alt` parse10++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 = tokens "101010100" `build` const "s"++parse1, parse0 :: Parse Char String+parse1 = token '1' `build` const "1"+parse0 = token '0' `build` const "0"
+ src/zot.hs view
@@ -0,0 +1,23 @@+module Main where++import qualified Zot+import qualified LambdaToSki+import qualified SkiToLambda+import qualified SkiToZot+import qualified ZotToSki+import qualified AddEcho++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
+ zot.cabal view
@@ -0,0 +1,42 @@+build-type:	Simple+cabal-version:	>= 1.6++name:		zot+version:	0.0.1+stability:	experimental+author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp>+maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>++license:	BSD3+license-file:	LICENSE++category:	Language+synopsis:	Zot language+description:+  Zot language+  .+  > echo "10100" | cat examples/reverse.zot - | zot -+  > 00101+  .+  > cat examples/reverse.lambda | zot lambdaToSki | zot skiToZot | zot arg "10100" | zot -+  > 00101+  .+  And try+  .+  > cat examples/reverse.zot | zot zotToSki | zot skiToLambda 3+  .+  and+  .+  > cat examples/reverse.zot | zot zotToSki | zot skiToLambda 3 -h++data-files:	examples/reverse.lambda, examples/reverse.zot++source-repository	head+  type:		git+  location:	git://github.com/YoshikuniJujo/zot_haskell.git++executable	zot+  hs-source-dirs:	src+  main-is:		zot.hs+  other-modules:	Zot, LambdaToSki, SkiToLambda, SkiToZot, ZotToSki, AddEcho, Parse, ReadLambda, SKI+  build-depends:	base > 3 && < 5, monads-tf