module Slurp
	( Seq, Bits
	, slurpFile
	, prettyBits)

where

import Data.Char
import Data.List
import Control.Monad
import Control.Monad.State

import Data.Map	(Map)
import qualified Data.Map	as Map

-- 
type Seq	= [String]
type Bits	= Map String [String]


-- | Slurp bits from this file
slurpFile
	:: String 	-- .s code
	-> ( String	-- leftover
	   , Seq	-- bit sequence
	   , Bits)	-- bits

slurpFile file
 = do	-- parse the assembly code
	let (leftover, state)	
		= runState (slurp (lines file)) stateInit
		
	(  unlines leftover
	 , stateSequence state
	 , stateClosures state)


-- Slurper Monad ---------------------------------------------------------------
type SlurpM	= State SlurpS
data SlurpS	
	= SlurpS

	-- | lines of current closure already eaten
	{ stateEaten	:: [String]		

	-- | the name of the closure, if we've found it
	, stateLabel	:: Maybe String

	-- | closures found so far
	, stateClosures	:: Map String [String] 

	-- | the sequence of closures
	, stateSequence	:: [String] 
	
	-- | a unique id for generating the name of anonymous bits
	, stateUnique	:: Int }
	deriving Show

stateInit
	= SlurpS
	{ stateEaten	= []
	, stateLabel	= Nothing
	, stateClosures	= Map.empty 
	, stateSequence	= [] 
	, stateUnique	= 0 }


prettySlurpS s
	=  "-- eaten ---\n"
	++ unlines (stateEaten s)
	++ "-- label --- \n"
	++ show (stateLabel s) ++ "\n"
	++ "-- closures ---\n"
--	++ show (Map.keys $ stateClosures s)
--	++ "\n"
	++ (concatMap prettyClosure $ Map.toList $ stateClosures s)
	++ "\n"
	++ "-- sequence ---\n"
	++ (concat $ intersperse "\n" $ stateSequence s)
	
	
prettyBits :: Map String [String] -> String
prettyBits mm
	= concatMap prettyClosure 
	$ Map.toList mm

prettyClosure (name, lines)
	= "--- " ++ name ++ "\n"
	++ (unlines lines)
	++ "\n\n\n"


--------------------------------------------------------------------------------
-- | Eat a line, adding it to the current closure
eat :: String -> SlurpM ()
eat str		= modify $ \s -> s { stateEaten = stateEaten s ++ [str] }

-- | Get a new unique
getUnique :: SlurpM Int
getUnique
 = do	s	<- get	
 	modify	$ \s -> s { stateUnique = stateUnique s + 1 }
	return	$ stateUnique s

-- | Add the current closure to the map
swallow :: SlurpM ()
swallow 
 = do	s	<- get
	label	<- case stateLabel s of
			Just l	-> return l
			Nothing	-> 
			 do	u	<- getUnique
			 	return	$ "__anon " ++ show u

   	modify $ \s -> s 
   		{ stateEaten	= []
		, stateLabel	= Nothing
		, stateClosures	= Map.insert label (stateEaten s) (stateClosures s) 
		, stateSequence	= stateSequence s ++ [label] }


-- | Set the current closure label
setLabel :: Maybe String -> SlurpM ()
setLabel ms	= modify $ \s -> s { stateLabel = ms }


-- | Slurp the first closure chunk from this file
slurp 	:: [String] 
	-> SlurpM 
		[String] 	-- left over lines

slurp []
 = do	return []

slurp (x:xs)

	-- start the chunk
	|   isPrefixOf ".text" x
	= do	setLabel Nothing
		eat x
		slurp_info xs
	 
	| isPrefixOf ".data" x
	= do	setLabel Nothing
		eat x
		slurp_data xs

	| otherwise
	= return xs


-- .data for SRT and other junk should come first
slurp_data []	
	= do	swallow
		return []
	
slurp_data xx@(x:xs)

	-- maybe more .data sections at the front
	| ".data"	<- x
	= do	swallow
		slurp xx

	-- looks like the info table	
	| ".text"	<- x
	= do	swallow
		slurp xx

	-- label 
	| isGlobalLabel x
	= do	eat x
		setLabel (Just x)
		slurp_data xs	
	
	| otherwise
	= do	eat x
		slurp_data xs


-- the label of the closure should be after the info table
slurp_info xx@(x1:xs)

	-- label then . local label
	| isGlobalLabel x1

	, (x2:xss)	<- xs
	, '.' : _	<- x2
	= do	eat x1
		eat x2
		setLabel (Just x1)
		slurp_body xss
	
	-- label 
	| isGlobalLabel x1
--	, not $ isSuffixOf "_srt:" x1
	= do	eat x1
		setLabel (Just x1)
		slurp_body xs	
		
	| otherwise
	= do	eat x1
		slurp_info xs

-- the C file ends with some data for some reason
-- slurp_info xx@[]

		
-- eat the body until the next .text or .data label
slurp_body []
	= do	swallow
		return []
	
slurp_body (x:xs)
 	| x == ".data" || x == ".text"
	= do	swallow
		slurp (x:xs)
		
	-- some label
	| '.' : _	<- x
	= do	eat x
		slurp_body xs
		
	| otherwise
	= do	eat x
		slurp_body xs

isGlobalLabel :: String -> Bool
isGlobalLabel ss@(x:_)
	| isSpace x	= False
	| x == '.'	= False
	| otherwise	= elem ':' ss