symbol-table-type.sml 5.97 KB
Newer Older
Axel Simon's avatar
Axel Simon committed
1
signature SymbolTableSig  = sig
2

mb0's avatar
Style    
mb0 committed
3
4
5
   type symid
   type table

Axel Simon's avatar
Axel Simon committed
6
   val noSpan : Error.span
7
   val compare_span : Error.span * Error.span -> order
Axel Simon's avatar
Axel Simon committed
8
   val eq_span : Error.span * Error.span -> bool
9
   
Axel Simon's avatar
Axel Simon committed
10
   val compare_symid : symid * symid -> order
Axel Simon's avatar
Axel Simon committed
11
   val eq_symid : symid * symid -> bool
Axel Simon's avatar
Axel Simon committed
12

mb0's avatar
Style    
mb0 committed
13
   val empty : table
Axel Simon's avatar
Axel Simon committed
14
15
16
17
18
19
20

   exception InvalidSymbol of Atom.atom
   val lookup : (table * Atom.atom) -> symid

   val find : (table * Atom.atom) -> symid option

   exception SymbolAlreadyDefined
mb0's avatar
Style    
mb0 committed
21
   val create : (table * Atom.atom * Error.span) -> (table * symid)
mb0's avatar
mb0 committed
22
   val fresh: table * Atom.atom -> table * symid
Axel Simon's avatar
Axel Simon committed
23
24
25

   val push : table -> table
   val pop : table -> table
Axel Simon's avatar
Axel Simon committed
26

27
28
29
30
31
32
   (*allow creating scopes whose definitions can later be reconstructed*)
   type references
   
   val pushWithReferences : table * references -> table
   val popWithReferences : table -> table * references

mb0's avatar
mb0 committed
33
34
   val listItems: table -> symid list

Axel Simon's avatar
Axel Simon committed
35
   val getAtom : (table * symid) -> Atom.atom
Axel Simon's avatar
Axel Simon committed
36
   val getInternalString : (table * symid) -> string
Axel Simon's avatar
Axel Simon committed
37
   val getString : (table * symid) -> string
Axel Simon's avatar
Axel Simon committed
38
   val getSpan : (table * symid) -> Error.span
39

Axel Simon's avatar
Axel Simon committed
40
   val toString : table -> string
mb0's avatar
mb0 committed
41
   val toInt: symid -> int
mb0's avatar
mb0 committed
42
43
   val unsafeFromWord: word -> symid
   val unsafeFromInt: int -> symid
Axel Simon's avatar
Axel Simon committed
44
45
46
end

structure SymbolTable :> SymbolTableSig = struct
47

48
   val concisePrint : bool = true
Axel Simon's avatar
Axel Simon committed
49

mb0's avatar
Up.    
mb0 committed
50
   structure SymbolTable = IntBinaryMap
mb0's avatar
Style    
mb0 committed
51
52
53
   structure Reverse = AtomRedBlackMap

   datatype symid = SymId of int
54

mb0's avatar
mb0 committed
55
   fun toInt (SymId i) = i
mb0's avatar
mb0 committed
56
57
58
   val unsafeFromInt = SymId
   val unsafeFromWord = unsafeFromInt o Word.toInt

mb0's avatar
mb0 committed
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
   val noSpan =
      {file=AntlrStreamPos.mkSourcemap(),
       span=(Position.fromInt ~1, Position.fromInt ~1)}

   fun compare_span ({file=f1,span=(p1s,p1e)}, {file=f2,span=(p2s,p2e)}) =
      let
         fun fname f = Option.getOpt (AntlrStreamPos.fileName f 0,"")
      in
         case String.compare (fname f1, fname f2) of
            EQUAL =>
               (case Int.compare (Position.toInt p1s, Position.toInt p2s) of
                  EQUAL =>
                     Int.compare (Position.toInt p1e, Position.toInt p2e)
                | res => res)
          | res => res
      end
   fun eq_span (a, b) = compare_span (a, b) = EQUAL
76

Axel Simon's avatar
Axel Simon committed
77
   fun compare_symid (SymId i1, SymId i2) = Int.compare (i1,i2)
Axel Simon's avatar
Axel Simon committed
78
79
   fun eq_symid  (SymId i1, SymId i2) = i1=i2
   
Axel Simon's avatar
Axel Simon committed
80
81
   exception SymbolAlreadyDefined

Axel Simon's avatar
Axel Simon committed
82
   type SymbolInfo = Atom.atom * Error.span * symid
83

Axel Simon's avatar
Axel Simon committed
84
   type table = (SymbolInfo SymbolTable.map * symid Reverse.map list)
mb0's avatar
Style    
mb0 committed
85

Axel Simon's avatar
Axel Simon committed
86
   fun emptySymInfo (atom,span,id) = (atom, span, id)
mb0's avatar
Style    
mb0 committed
87

Axel Simon's avatar
Axel Simon committed
88
   val empty = (SymbolTable.empty, [Reverse.empty])
mb0's avatar
Style    
mb0 committed
89

mb0's avatar
mb0 committed
90
91
   fun listItems ((map, _):table) = List.map #3 (SymbolTable.listItems map)

Axel Simon's avatar
Axel Simon committed
92
   fun find ((st, []), atom) = NONE
93
     | find ((st, rev::r), atom) =
Axel Simon's avatar
Axel Simon committed
94
95
       case Reverse.find (rev, atom) of
           (SOME id) => SOME id
Axel Simon's avatar
Axel Simon committed
96
         | NONE => find ((st, r), atom)
mb0's avatar
Style    
mb0 committed
97

Axel Simon's avatar
Axel Simon committed
98
   exception InvalidSymbol of Atom.atom
Axel Simon's avatar
Axel Simon committed
99
   fun lookup (ts, atom) =
Axel Simon's avatar
Axel Simon committed
100
     case find (ts, atom) of
Axel Simon's avatar
Axel Simon committed
101
         (SOME id) => id
Axel Simon's avatar
Axel Simon committed
102
       | NONE => raise InvalidSymbol atom
Axel Simon's avatar
Axel Simon committed
103

Axel Simon's avatar
Axel Simon committed
104
   fun create (ts as (st, revs), atom, span) =
Axel Simon's avatar
Axel Simon committed
105
106
107
108
109
110
111
112
113
114
115
116
      let val (rev::r) = revs in
        case Reverse.find (rev, atom) of
           SOME id => raise SymbolAlreadyDefined
         | NONE =>
           let
              val no = SymbolTable.numItems st+1
              val id = SymId no
              val st = SymbolTable.insert (st, no, emptySymInfo (atom,span,id))
              val rev = Reverse.insert (rev, atom, id)
           in
              ((st,rev::r), id)
           end
Axel Simon's avatar
Axel Simon committed
117
      end
118

mb0's avatar
mb0 committed
119
120
121
122
123
124
125
126
   fun fresh ((st, revs), atom) = let
      val no = SymbolTable.numItems st + 1
      val id = SymId no
      val st = SymbolTable.insert (st, no, emptySymInfo (atom, noSpan, id))
   in
      ((st, revs), id)
   end

127
128
   exception NoMoreScopes
   
Axel Simon's avatar
Axel Simon committed
129
   fun push (st, r) = (st, Reverse.empty :: r)
130
131
132
133
134
135
136
137
   fun pop (st, _ :: r) = (st, r)
     | pop _ = raise NoMoreScopes

   type references = symid Reverse.map
   
   fun pushWithReferences ((st, r), refs) = (st, refs :: r)
   fun popWithReferences (st, refs :: r) = ((st, r), refs)
     | popWithReferences _ = raise NoMoreScopes
138

Axel Simon's avatar
Axel Simon committed
139
140
   exception InvalidSymbolId

Axel Simon's avatar
Axel Simon committed
141
142
143
144
145
   fun getSymbolInfo ((st, _), SymId idx) =
        case SymbolTable.find (st, idx) of
            (SOME c) => c
          | (NONE) => raise InvalidSymbolId

Axel Simon's avatar
Axel Simon committed
146
   fun getAtom ti = let val (atom,_,_) = getSymbolInfo ti in atom end
Axel Simon's avatar
Axel Simon committed
147
148
   fun getInternalString (ti as (_, SymId i)) =
      Atom.toString (getAtom ti) ^ Int.toString i
149
   fun getString (ti as (_, SymId i)) =
Axel Simon's avatar
Axel Simon committed
150
151
      Atom.toString (getAtom ti) ^ 
         (if concisePrint then "" else "#" ^ Int.toString i)
Axel Simon's avatar
Axel Simon committed
152
   fun getSpan ti = let val (_,span,_) = getSymbolInfo ti in span end
153

Axel Simon's avatar
Axel Simon committed
154
155
156
157
158
159
160
161
162
   fun toString (st, revs) =
      let val (r :: rev) = revs
          fun fS a i [] = 10000
            | fS a i (r :: rev) =
              (case Reverse.find (r, a) of
                  NONE => 1+fS a i rev
                | SOME (SymId j) => if j<>i then 1+fS a i rev else 0
              )
          and findScope a i = case fS a i revs of
163
                0 => ""
Axel Simon's avatar
Axel Simon committed
164
165
166
167
168
169
170
171
172
173
174
              | 1 => " declared 1 scope up"
              | n => if n<10000 then " declared " ^ Int.toString(n) ^ " scopes up"
                     else " out of scope"
      in
        List.foldl (op ^) (Int.toString (List.length revs) ^ " scopes\n") (
          List.map
            (fn (a,_,SymId i) => Int.toString i ^ " -> " ^ Atom.toString a ^
                                 findScope a i ^ "\n")
            (SymbolTable.listItems st)
          )
      end
175

Axel Simon's avatar
Axel Simon committed
176
177
178
179
180
181
182
end

structure ord_symid = struct
  type ord_key = SymbolTable.symid
  val compare = SymbolTable.compare_symid
end

183
184
185
186
187
188
189
190
191
192
193
structure SymTab = struct
   structure Key = struct
      type hash_key = SymbolTable.symid
      val hashVal = Word.fromInt o SymbolTable.toInt
      val sameKey = SymbolTable.eq_symid
   end
   structure Tab = HashTableFn(Key)
   open Tab
   fun new () = mkTable(1000,Fail"Invalid symbol")
end

mb0's avatar
Up.    
mb0 committed
194
195
196
structure SymMap = BinaryMapFn(ord_symid)
structure SymSet = BinarySetFn(ord_symid)
structure SymListSet = SymSet
197
198
199
200
201

structure SpanMap = RedBlackMapFn(struct
   type ord_key = Error.span
   val compare = SymbolTable.compare_span
end)