1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
|
(*
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;
|
