(*
	Copyright (c) 2000
		Cambridge University Technical Services Limited

    Modified David C.J. Matthews 2008.

	This library is free software; you can redistribute it and/or
	modify it under the terms of the GNU Lesser General Public
	License as published by the Free Software Foundation; either
	version 2.1 of the License, or (at your option) any later version.
	
	This library is distributed in the hope that it will be useful,
	but WITHOUT ANY WARRANTY; without even the implied warranty of
	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
	Lesser General Public License for more details.
	
	You should have received a copy of the GNU Lesser General Public
	License along with this library; if not, write to the Free Software
	Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
*)


(*
    Title: 	Control debugging output.
    Author: 	Dave Matthews, Cambridge University Computer Laboratory
    Copyright   Cambridge University 1985
*)


structure Debug =

(*****************************************************************************)
(*                  Body of DEBUG                                            *)
(*****************************************************************************)
struct
    local
        open Universal
    in
        (* Print error and warning messages. *)
        val errorMessageProcTag: (string * bool * int -> unit) tag = tag()
        (* Compiler output.  Used for timing information and compiler debug output. *)
        val compilerOutputTag: (string->unit) tag    = tag()
        (* Get the current line number. *)
        val lineNumberTag: (unit->int) tag           = tag()

        (* File name.  Only used in the debugger so may be taken out. *)
        val fileNameTag: string tag                  = tag()

        (* Print times for compilation and execution: default false. *)
        val timingTag: bool tag                      = tag()
        (* Profile executed code?  default 0. *)
        val profilingTag: int tag                    = tag()
        (* How much to print in error messages?  default 6 *)
        val errorDepthTag: int tag                   = tag()
        (* Control print depth in PolyML.print. *)
        val printDepthFunTag: (unit->int) tag            = tag()
        (* Length of line in PolyML.print. error messages etc. *)
        val lineLengthTag: int tag                   = tag()
        (* ML97 or ML90 mode? default ML97 *)
        val ml90Tag: bool tag                        = tag()
        (* Compile in debugging code?  default false *)
        val debugTag: bool tag                       = tag()
        (* Stream to use for output in PolyML.print *)
        val printStringTag: (string->unit) tag       = tag()
        (* Compilation fine tuning. *)
        (* Should functors be made inline? default true. *)
        val inlineFunctorsTag: bool tag              = tag()
        (* Control how big functions should be before they're not inlined. *)
        val maxInlineSizeTag: int tag                = tag()

        (* Compiler debugging. *)
        (* Trace exceptions generated within the compiler? default false. *)
        val traceCompilerTag: bool tag               = tag()
        (* Print parsetree after parsing? default false *)
        val parsetreeTag: bool tag                   = tag()
        (* Print codetree after compiling? default false *)
        val codetreeTag: bool tag                    = tag()
        (* Print the optimised code after compiling? default false *)
        val codetreeAfterOptTag: bool tag            = tag()
        (* Print pseudo-stack in code-generator? default false *)
        val pstackTraceTag: bool tag                 = tag()
        (* Print assembly code in code-generator? default false *)
        val assemblyCodeTag: bool tag                = tag()
        
        (* To avoid circularity of dependencies a few tags are defined
           elsewhere:  *)
        (* val printSpaceTag: ValueOps.nameSpace tag
           val debuggerFunTag: Debgger.debugger tag *)


        val defaults =
        [
            tagInject errorMessageProcTag (fn _ => raise Fail "error in program"),
            tagInject compilerOutputTag (fn _ => ()), (* Discard output. *)
            tagInject lineNumberTag (fn () => 0), (* Zero line number *)
            tagInject fileNameTag "",
            tagInject inlineFunctorsTag true,
            tagInject maxInlineSizeTag 40,
            tagInject parsetreeTag false,
            tagInject codetreeTag false,
            tagInject pstackTraceTag false,
            tagInject assemblyCodeTag false,
            tagInject codetreeAfterOptTag false,
            tagInject timingTag false,
            tagInject profilingTag 0,
            tagInject errorDepthTag 6,
            tagInject printDepthFunTag (fn () => 0),
            tagInject lineLengthTag 77,
            tagInject traceCompilerTag false,
            tagInject ml90Tag false,
            tagInject debugTag false,
            tagInject printStringTag (fn s => raise Fail "No stream")
        ]
    
        fun getParameter (t:'a tag) (tagList: universal list) :'a =
        case List.find (tagIs t) tagList of
            SOME a => tagProject t a
        |   NONE => (* Use the default *)
            (
                case List.find (tagIs t) defaults of
                    SOME a => tagProject t a
                |   NONE => raise Misc.InternalError "tag missing"
            )
    end
        
end;
