implementation module Sil.Util

import _SystemArray
import StdEnum
from StdFunc import id
import StdInt
import StdList
import StdOverloaded
import StdString

from Data.Func import $
import Data.List
import Data.Maybe
import Text

import Sil.Parse
import Sil.Syntax

:: PrintState =
	{ indent :: Int
	}

instance zero PrintState where zero = {indent=0}

instance toString PrintState where toString st = {'\t' \\ _ <- [1..st.indent]}

instance PrettyPrinter [Token]
where
	print st []             = ""
	print st [t]            = toString t
	print st [t:ts=:[t`:_]] = toString t +++ spaceBetween t t` +++ print st` ts
	where
		st` = {st & indent=indent`}
		indent` = newIndent t t` st.indent

		spaceBetween :: Token Token -> String
		spaceBetween _           TBraceClose = newline
		spaceBetween TParenOpen  _           = ""
		spaceBetween TParenClose TBraceOpen  = space
		spaceBetween TParenClose _           = ""
		spaceBetween TBraceOpen  _           = newline
		spaceBetween TBraceClose _           = newline
		spaceBetween TComma      _           = space
		spaceBetween TSemicolon  _           = newline
		spaceBetween TAssign     _           = space
		spaceBetween (TLit _)    _           = space
		spaceBetween TIf         _           = space
		spaceBetween TWhile      _           = space
		spaceBetween TReturn     _           = space
		spaceBetween (TName _)   TParenClose = ""
		spaceBetween (TName _)   TSemicolon  = ""
		spaceBetween (TName _)   _           = space

		newline = "\r\n" +++ {'\t' \\ _ <- [1..indent`]}
		space = " "

		newIndent :: Token Token -> Int -> Int
		newIndent TBraceOpen  _           = inc
		newIndent _           TBraceClose = dec
		newIndent _           _           = id

instance PrettyPrinter Program
where
	print st prog = p st prog.p_funs
	where
		p :: PrintState [Function] -> String
		p _  []     = ""
		p st [f]    = print st f
		p st [f:fs] = print st f <+ "\r\n\r\n" <+ p st fs

instance PrettyPrinter Function
where
	print st f = st <+ f.f_type <+ " " <+ f.f_name
		<+ "(" <+ printersperse ", " f.f_args <+ ") {\r\n"
		<+ print {st & indent=st.indent+1} f.f_code <+ "\r\n" <+ st <+ "}"

instance PrettyPrinter CodeBlock
where
	print st cb = concat $ intersperse "\r\n" $
		[print st x \\ x <- cb.cb_init] ++ [print st x \\ x <- cb.cb_content]

instance PrettyPrinter Initialisation
where
	print st init = st <+ init.init_type <+ " " <+ init.init_name <+ ";"

instance PrettyPrinter Statement where print st stm = st <+ stm <+ ";"

instance toString Statement
where
	toString (Declaration n a) = n <+ " " <+ TAssign <+ " " <+ a
	toString (Application app) = toString app
	toString (Return Nothing)  = "return"
	toString (Return (Just a)) = "return " <+ a <+ ""
	toString _                 = "<<unimplemented Statement>>"

instance toString Type
where
	toString TBool = "Bool"
	toString TInt  = "Int"
	toString TVoid = "Void"

instance toString Arg where toString arg = arg.arg_type <+ " " <+ arg.arg_name

instance toString Application
where
	toString (Name n)      = n
	toString (Literal lit) = toString lit
	toString (App n args)  = n <+ "(" <+ printersperse ", " args <+ ")"

instance toString Literal
where
	toString (BLit b) = toString b
	toString (ILit i) = toString i

printersperse :: a [b] -> String | toString a & toString b
printersperse _ []     = ""
printersperse _ [x]    = toString x
printersperse g [x:xs] = x <+ g <+ printersperse g xs