File: Common.hs

package info (click to toggle)
ctklight 0.17.11-1
  • links: PTS
  • area: main
  • in suites: potato
  • size: 176 kB
  • ctags: 41
  • sloc: haskell: 514; makefile: 26; sh: 12
file content (149 lines) | stat: -rw-r--r-- 4,184 bytes parent folder | download
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
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
--  Compiler Toolkit: some basic definitions used all over the place
--
--  Author : Manuel M. T. Chakravarty
--  Created: 16 February 95
--
--  Version $Revision: 1.40 $ from $Date: 1999/09/22 09:36:29 $
--
--  Copyright (c) [1995..1999] Manuel M. T. Chakravarty
--
--  This library is free software; you can redistribute it and/or
--  modify it under the terms of the GNU Library General Public
--  License as published by the Free Software Foundation; either
--  version 2 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
--  Library General Public License for more details.
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  This module provides some definitions used throughout all modules of a
--  compiler. 
--
--- DOCU ----------------------------------------------------------------------
--
--  language: Haskell 98
--
--  * May not import anything apart from `Config'.
--
--- TODO ----------------------------------------------------------------------
--
 
module Common (-- error code
	       --
	       errorCodeError, errorCodeFatal,
	       --
	       -- source text positions
	       --
	       Position, Pos (posOf), nopos, isNopos, dontCarePos, 
	       isDontCarePos, builtinPos, isBuiltinPos,
	       --
	       -- pretty printing
	       --
	       PrettyPrintMode(..), dftOutWidth, dftOutRibbon,
	       --
	       -- support for debugging
	       --
	       assert)
where

import Config      (assertEnabled)


-- error codes
-- -----------

-- error code when a compilation spotted program errors (EXPORTED)
--
errorCodeError :: Int
errorCodeError  = 1

-- error code for fatal errors aborting the run of the toolkit (EXPORTED)
--
errorCodeFatal :: Int
errorCodeFatal  = 2


-- Miscellaneous stuff for parsing
-- -------------------------------

-- uniform representation of source file positions; the order of the arguments
-- is important as it leads to the desired ordering of source positions
-- (EXPORTED) 
--
type Position = (String,	-- file name
		 Int,		-- row
		 Int)		-- column

-- no position (for unknown position information) (EXPORTED)
--
nopos :: Position
nopos  = ("<no file>", -1, -1)

isNopos	            :: Position -> Bool
isNopos (_, -1, -1)  = True
isNopos _	     = False

-- don't care position (to be used for invalid position information) (EXPORTED)
--
dontCarePos :: Position
dontCarePos  = ("<invalid>", -2, -2)

isDontCarePos	          :: Position -> Bool
isDontCarePos (_, -2, -2)  = True
isDontCarePos _		   = False

-- position attached to objects that are hard-coded into the toolkit (EXPORTED)
--
builtinPos :: Position
builtinPos  = ("<built into the compiler>", -3, -3)

isBuiltinPos	         :: Position -> Bool
isBuiltinPos (_, -3, -3)  = True
isBuiltinPos _		  = False

-- instances of the class `Pos' are associated with some source text position
-- don't care position (to be used for invalid position information) (EXPORTED)
--
class Pos a where
  posOf :: a -> Position


-- Miscellaneous stuff for pretty printing 
-- ---------------------------------------

-- pretty printing modes (EXPORTED)
--
data PrettyPrintMode = PPMRaw		-- display raw structure only
		     | PPMVerbose	-- display all available info

-- default parameters used for pretty printing (EXPORTED)
--

dftOutWidth :: Int
dftOutWidth  = 79

dftOutRibbon :: Int
dftOutRibbon  = 50


-- support for debugging
-- ---------------------

-- assert is used to catch internal inconsistencies and raises a fatal internal
-- error if such an inconsistency is spotted (EXPORTED)
--
-- an inconsistency occured when the first argument to `assert' is `False'; in
-- a distribution version, the checks can be disabled by setting
-- `assertEnabled' to `False'---to favour speed
--
assert         :: Bool -> String -> a -> a
assert p msg v  = if assertEnabled
		  then
		    if p then v else error (premsg ++ msg ++ "\n")
		  else
		    v
		  where
		    premsg = "INTERNAL COMPILER ERROR: Assertion failed:\n"