module Sk where

import Control.Monad
import System (getArgs)
import Text.ParserCombinators.Parsec

import Lambda
import Numbers

data SkExp =
	CombS
	| CombK
	| SkApp SkExp SkExp
	deriving (Eq,Show)

-- i = skk = (s k) k

iCombSK = SkApp (SkApp CombS CombK) CombK

skToNum CombS = [1,0] -- x (x x)
skToNum CombK = [0] -- (x x)
skToNum (SkApp x y) = xs++[n]++ys
	where
		xs = skToNum x
		ys = skToNum y
		n = max (maximum xs) (maximum ys + 1)

-- The Lazy K webpage, at http://homepages.cwi.nl/~tromp/cl/lazy-k.html, has some
-- interesting test programs. For example a pretty large sieve of eratosthenes
-- example on the top. This parser only parses the simple paranthesised SKI
-- sub-language.

parseLazyK :: [Char] -> SkExp
parseLazyK input = runP skiExpression $
	-- Filter out any non-SKI tokens (i.e. whitespace)
	filter (flip elem "KSI()") input

parenthesized parser = char '(' >> parser >>= \x -> char ')' >> return x

alt = foldl1 (<|>)

-- LazyK ::= (K | S | I | '(' LazyK ')' ){1,}
skiExpression :: Parser SkExp
skiExpression = return . foldl1 SkApp =<< many1 (alt
		[parenthesized skiExpression
		,char 'K' >> return CombK
		,char 'S' >> return CombS
		,char 'I' >> return iCombSK])

skStar :: Parser SkExp
skStar = alt
	[char '*' >> liftM2 SkApp skStar skStar
	,char 'S' >> return CombS
	,char 'K' >> return CombK]

lazyKFromFile name = fmap parseLazyK (readFile name)

runP :: Show a => Parser a -> String -> a
runP p input
       = case (parse p "" input) of
           Left err -> error ("parse error at " ++ (show err))
           Right x  -> x

skToLambda = parseNum . skToNum

lazyRun file = putStrLn . runWithInput emptyInput . skToLambda =<< 
	lazyKFromFile file

main = lazyRun . head =<< getArgs