Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/Semant/elaborate/tyvarset.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/Semant/elaborate/tyvarset.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 16 - (view) (download)

1 : monnier 16 (* tyvarset.sml
2 :     *
3 :     * COPYRIGHT (c) 1996 Bell Laboratories.
4 :     *
5 :     *)
6 :    
7 :     signature TYVARSET =
8 :     sig
9 :     type tyvarset
10 :     val empty : tyvarset
11 :     val singleton : Types.tyvar -> tyvarset
12 :     val mkTyvarset : Types.tyvar list -> tyvarset
13 :     val union : tyvarset * tyvarset * ErrorMsg.complainer -> tyvarset
14 :     val diff : tyvarset * tyvarset * ErrorMsg.complainer -> tyvarset
15 :     val diffPure : tyvarset * tyvarset -> tyvarset
16 :     val elements: tyvarset -> Types.tyvar list
17 :     end (* signature TYVARSET *)
18 :    
19 :     structure TyvarSet :> TYVARSET =
20 :     struct
21 :    
22 :     local
23 :     structure EM = ErrorMsg
24 :     open Types
25 :     fun bug msg = ErrorMsg.impossible("TyvarSet: "^msg)
26 :     in
27 :    
28 :     type tyvarset = tyvar list
29 :    
30 :     val empty = nil
31 :     fun singleton t = [t]
32 :     fun mkTyvarset l = l
33 :     fun elements s = s
34 :    
35 :     fun mem(a as ref(UBOUND{name=name_a,eq=eq_a,depth=depth_a}),
36 :     (b as ref(UBOUND{name=name_b,eq=eq_b,depth=depth_b}))::rest,err) =
37 :     if a=b then true
38 :     else if Symbol.eq(name_a,name_b) then
39 :     (if eq_a<>eq_b then
40 :     err EM.COMPLAIN ("type variable " ^ (Symbol.name name_a) ^
41 :     " occurs with different equality properties \
42 :     \in the same scope")
43 :     EM.nullErrorBody
44 :     else ();
45 :     if depth_a<>depth_b then bug "mem - depths differ" else ();
46 :     (* UBOUND tyvars are created with depth infinity and
47 :     * this should not change until type checking is done *)
48 :     a := INSTANTIATED(VARty b);
49 :     true)
50 :     else mem(a,rest,err)
51 :     | mem _ = false
52 :    
53 :     fun memP(a as ref(UBOUND{name=name_a,...}),
54 :     (b as ref(UBOUND{name=name_b,...}))::rest) =
55 :     if a=b then true
56 :     else if Symbol.eq(name_a,name_b) then true
57 :     else memP(a,rest)
58 :     | memP _ = false
59 :    
60 :     fun union([],s,err) = s
61 :     | union(s,[],err) = s
62 :     | union(a::r,s,err) =
63 :     if mem(a,s,err) then union(r,s,err)
64 :     else a::union(r,s,err)
65 :    
66 :     fun diff(s,[],err) = s
67 :     | diff([],_,err) = []
68 :     | diff(a::r,s,err) =
69 :     if mem(a,s,err) then diff(r,s,err)
70 :     else a::diff(r,s,err)
71 :    
72 :     fun diffPure(s,[]) = s
73 :     | diffPure([],_) = []
74 :     | diffPure(a::r,s) =
75 :     if memP(a,s) then diffPure(r,s)
76 :     else a::diffPure(r,s)
77 :    
78 :     end (* local *)
79 :     end (* abstraction TyvarSet *)
80 :    
81 :     (*
82 :     * $Log: tyvarset.sml,v $
83 :     * Revision 1.5 1997/09/05 04:43:48 dbm
84 :     * Changes in names of exported values. New function diffPure. (bug 1246)
85 :     *
86 :     * Revision 1.4 1997/04/14 21:31:43 dbm
87 :     * Added new function mktyvarset that was needed in ElabCore in the
88 :     * elaboration of explicit type variable bindings.
89 :     *
90 :     * Revision 1.3 1997/03/22 18:18:43 dbm
91 :     * Modified for changes to tyvar representation introduced for better
92 :     * handling of overloaded literals and fix for bug 905/952.
93 :     *
94 :     * Revision 1.2 1997/01/31 20:39:57 jhr
95 :     * Replaced uses of "abstraction" with opaque signature matching.
96 :     *
97 :     * Revision 1.1.1.1 1997/01/14 01:38:35 george
98 :     * Version 109.24
99 :     *
100 :     *)

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0