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
|
(*
Copyright (c) 2000
Cambridge University Technical Services Limited
Further development: Copyright David C.J. Matthews 2016
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License version 2.1 as published by the Free Software Foundation.
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: Table of printing functions for user-defined types.
Author: Dave Matthews, Cambridge University Computer Laboratory
Copyright Cambridge University 1990
*)
(*
The original purpose of this module was to allow for type-dependent
print functions to be installed by the user. That requires a special
mechanism to allow a function to be installed in a child database without
needing to be able to write to the top-level database containing the
compiler.
This has been extended to deal with SML97 overloading for both functions
and literal constants and also for ref-like types which support pointer
equality even though these cases are intended only for the implementors
of libraries which would probably be in the top-level database.
*)
functor PRINT_TABLE (
structure CODETREE: CODETREESIG
structure STRUCTVALS : STRUCTVALSIG
structure PRETTY : PRETTYSIG
): PRINTTABLESIG =
struct
open STRUCTVALS;
type pretty = PRETTY.pretty
open CODETREE
type overloadEntry = string * typeConstrs * codetree;
(* Create a ref to hold the list *)
val overloadTable : overloadEntry list ref = ref []
(* The most recent ref refers to the current level of the hierarchy,
so is the one we should update. *)
fun addOverload (name, cons, overload) =
let
(* Remove any existing occurrences of the type. The only reason
is to allow any existing function to be garbage-collected. *)
fun filter [] = []
| filter ((this as (n, t, _)) :: rest) =
if n = name andalso
sameTypeId (tcIdentifier cons, tcIdentifier t)
then filter rest
else this :: filter rest
in
overloadTable := (name, cons, overload) :: filter (!overloadTable)
end
(* Return all the overloads for a particular identifier. *)
fun getOverloads name =
let
fun searchList [] = []
| searchList ((n,t,v)::rest) =
if name = n then (t, v) :: searchList rest else searchList rest
in
searchList (! overloadTable)
end;
(* Return the first matching overload or call mkDefault. *)
fun getOverload(name, constr, mkDefault) =
let
fun searchList [] = mkDefault()
| searchList ((n,t,v)::rest) =
if name = n andalso
sameTypeId (tcIdentifier constr, tcIdentifier t)
then v else searchList rest
in
searchList (! overloadTable)
end;
structure Sharing =
struct
type codetree = codetree
and typeConstrs = typeConstrs
end
end;
|
