module Numbers (parseNum, numRun, numRunFile) where

import Control.Arrow
import Data.List (foldl')
import Data.Maybe
import Debug.Trace
import IO
import System (getArgs)

import Lambda

showStack [] = "$"
showStack (x:xs) = (showStack xs) ++ " " ++ (show x)

showStack' xs = show (length xs)

showState :: (Show t, Ord t) => String -> [t] -> [LambdaExp] -> [t] -> a -> a
showState pref ops vals xs = trace
	(pref ++ ":\n" ++ 
		"OPS:\n\t" ++ showStack ops  ++ "\n" ++
		"VAL:\n\t" ++ showStack vals ++ "\n" ++
		"XS:\n\t" ++ show xs ++"\n")

parseNum' xs = parse ([],[xComb]) xs

parse :: (Show t, Ord t) => ([t], [LambdaExp]) -> [t] -> LambdaExp

parse (op:ops,v1:v2:vs)  (x:xs)
  | op > x                         = parse (x:op:ops, xComb:v1:v2:vs) xs
parse (op:ops,v1:v2:vs)  (x:xs)
  | op <= x                        = parse (ops, App v2 v1 : vs)      (x:xs)
parse ([],vals)          (x:xs)    = parse ([x], xComb:vals)          xs
parse (op:ops, v1:v2:vs) []        = parse (ops, App v2 v1 : vs)      []
parse ([], [val])        []        = val
parse (ops,vals)         xs        = showState "Error" ops vals xs $ error "Parse error"

parseNum :: Ord t => [t] -> LambdaExp
parseNum xs =
	head.snd . reduceUntil (const False) . foldl' shiftReduce ([],[xComb]) $ xs
	where
		shiftReduce s x = (x:) *** (xComb:) $ reduceUntil (x <) s
		
		reduce (op:ops,v1:v2:vs) = (ops,App v2 v1:vs)
		reduce ([],[val]) = ([],[val])
		
		reduceUntil p = until (all p . take 1 . fst) reduce

numRunFile file = readFile file >>= numRun . readInts

readInts = read :: String -> [Integer]

numRun :: (Show t, Ord t) => [t] -> IO ()
numRun x = hSetBuffering stdout NoBuffering >> (putStrLn . runWithInput emptyInput . parseNum) x

main = getArgs >>= numRunFile . head