implementation module Sil.Util.Printer

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
import Sil.Types
import Sil.Util.Parser

:: PrintState =
	{ indent :: Int
	}

instance zero PrintState where zero = {indent=0}

incIndent :: PrintState -> PrintState
incIndent ps = {ps & indent=inc ps.indent}

decIndent :: PrintState -> PrintState
decIndent ps = {ps & indent=dec ps.indent}

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

instance PrettyPrinter String where print _ s = s

instance PrettyPrinter (Positioned a) | PrettyPrinter a
where print st p = print st $ fromPositioned p

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_globals=gs=:[_:_]}
		= stprintersperse st "\r\n" gs <+ "\r\n\r\n" <+ print st {prog & p_globals=[]}
	print st prog = stprintersperse st "\r\n\r\n" prog.p_funs

stprintersperse :: PrintState a [b] -> String | PrettyPrinter a & PrettyPrinter b
stprintersperse st _ []     = ""
stprintersperse st _ [x]    = print st x
stprintersperse st g [x:xs] = print st x +++ print st g +++ stprintersperse st g xs

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 <+ val <+ ";"
	where
		val = case init.init_value of
			Nothing -> ""
			Just v  -> " := " <+ v

instance PrettyPrinter Statement
where
	print st (If bs else) = st <+ printersperse " else " (map oneblock bs) <+ else`
	where
		st` = incIndent st
		oneblock (c,b) = "if (" <+ c <+ ") {\r\n" <+ print st` b <+ "\r\n" <+ st <+ "}"
		else` = case else of
			Nothing -> ""
			Just e  -> " else {\r\n" <+ print st` e <+ "\r\n" <+ st <+ "}"
	print st (While c do) = st <+ "while (" <+ c <+ ") {\r\n" <+
		print (incIndent st) do <+ "\r\n" <+ st <+ "}"
	print st stm = st <+ stm

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