#lang sml
(*
 * (c) Andreas Rossberg 2007
 *
 *)

structure PPGrammar : PP_GRAMMAR =
struct
    open TextIO

    fun ppIndent(out, i) = output(out, CharVector.tabulate(2*i, fn _ => #" "))
    fun ppBegin out      = output(out, "(")
    fun ppEnd out        = output(out, ")")

    fun ppPos(out, {abs, lin, col}) =
	( output(out, Int.toString abs)
	; output(out, "(")
	; output(out, Int.toString lin)
	; output(out, ".")
	; output(out, Int.toString col)
	; output(out, ")")
	)

    fun ppRegion(out, {left, right}) =
	( ppPos(out, left)
	; output(out, "-")
	; ppPos(out, right)
	)

    fun ppInfo(out, {file, region}) =
	( case file of NONE   => ()
		     | SOME f => (output(out, f); output(out, ":")) 
	; ppRegion(out, region)
	)

    fun ppHead'(out, i, s, I) =
	( ppIndent(out, i)
	; ppBegin out
	; output(out, s)
	; output(out, " ")
	; ppInfo(out, I)
	)

    fun ppFoot'(out, i, I) =
	( ppEnd out
	; output(out, "\n")
	)

    fun ppHead(out, i, s, I) = (ppHead'(out, i, s, I); output(out, "\n"))
    fun ppFoot(out, i, I)    = (ppIndent(out, i); ppFoot'(out, i, SOME I))
    fun ppHeadFoot(out, i, s, I) =
	(ppHead'(out, i, s, I); ppFoot'(out, i, I))

    fun ppAtom(out, i, s1, I, s2) =
	( ppHead'(out, i, s1, I)
	; output(out, " ")
	; output(out, s2)
	; ppFoot'(out, i, I)
	)

    fun ppElem(out, i, s, I, []) =
	  ppHeadFoot(out, i, s, I)
      | ppElem(out, i, s, I, subs) =
	( ppHead(out, i, s, I)
	; List.app (fn pp => pp(out, i+1)) subs
	; ppFoot(out, i, I)
	)

    fun ppOpt ppX (out, i, NONE)    = ()
      | ppOpt ppX (out, i, SOME x) = ppX(out, i, x)

    fun sub ppX x (out, i)      = ppX(out, i, x)
    fun subs ppX xs (out, i)    = List.app (fn x => ppX(out, i, x)) xs
    fun subo ppX x_opt (out, i) = ppOpt ppX (out, i, x_opt)
end