Annotation of /sml/trunk/src/cm/semant/modname.sml

Parent Directory | Revision Log

---

Revision 266 - (view) (download)

1 :	blume	266	(*
2 :			* semant/modname.sml:
3 :			* `module name' abstraction and related types
4 :			*
5 :			* Copyright (c) 1999 by Lucent Technologies
6 :			*
7 :			* author: Matthias Blume (blume@cs.princeton.edu)
8 :			*)
9 :			structure ModName : MODNAME = struct
10 :
11 :			structure Symbol = GenericVC.Symbol
12 :
13 :			type symbol = Symbol.symbol
14 :
15 :			type namespace = Symbol.namespace
16 :
17 :			exception ModuleNameError and PathError
18 :
19 :			type t = symbol
20 :			type path = t list
21 :			type set = t Set.set
22 :
23 :			val equal = Symbol.eq
24 :			val namespaceOf = Symbol.nameSpace
25 :			fun symbolOf n = n
26 :			fun nameOf n = Symbol.name n
27 :
28 :			val lt = Symbol.symbolCMLt
29 :
30 :			fun makestring mn =
31 :			(case Symbol.nameSpace mn of
32 :			Symbol.STRspace => "structure "
33 :			| Symbol.SIGspace => "signature "
34 :			| Symbol.FCTspace => "functor "
35 :			| Symbol.FSIGspace => "functor signature "
36 :			| _ => raise ModuleNameError)
37 :			^ (Symbol.name mn)
38 :
39 :			(* we don't really have to check the name space if we trust the parser *)
40 :			fun ofSymbol sy = sy
41 :
42 :			fun filterSymbols sl = let
43 :			fun filt (sy, l) =
44 :			case Symbol.nameSpace sy of
45 :			Symbol.STRspace => sy :: l
46 :			| Symbol.SIGspace => sy :: l
47 :			| Symbol.FCTspace => sy :: l
48 :			| Symbol.FSIGspace => sy :: l
49 :			| _ => l
50 :			in
51 :			foldr filt [] sl
52 :			end
53 :
54 :			val STRspace = Symbol.STRspace
55 :			val SIGspace = Symbol.SIGspace
56 :			val FCTspace = Symbol.FCTspace
57 :			val FSIGspace = Symbol.FSIGspace
58 :
59 :			val structMN = Symbol.strSymbol
60 :			val sigMN = Symbol.sigSymbol
61 :			val functMN = Symbol.fctSymbol
62 :			val funsigMN = Symbol.fsigSymbol
63 :
64 :			fun create (ns, n) =
65 :			(case ns of
66 :			Symbol.STRspace => structMN
67 :			| Symbol.SIGspace => sigMN
68 :			| Symbol.FCTspace => functMN
69 :			| Symbol.FSIGspace => funsigMN
70 :			| _ => raise ModuleNameError) n
71 :
72 :			fun pathFirstModule [] = raise PathError
73 :			| pathFirstModule (h :: _) = h
74 :
75 :			fun restOfPath [] = NONE
76 :			| restOfPath [_] = NONE
77 :			| restOfPath (_ :: t) = SOME t
78 :
79 :			fun pathLastModule [] = raise PathError
80 :			| pathLastModule [m] = m
81 :			| pathLastModule (_ :: t) = pathLastModule t
82 :
83 :			fun pathOfSymbolList sl = sl
84 :			fun mnListOfPath p = p
85 :			fun pathOfMNList l = l
86 :
87 :			fun createPathSML (sl, x) = foldl (fn (s, p) => (structMN s) :: p) [x] sl
88 :
89 :			fun nameOfPath [] = raise PathError
90 :			| nameOfPath [m] = nameOf m
91 :			| nameOfPath (h :: t) = (nameOf h) ^ "." ^ (nameOfPath t)
92 :
93 :
94 :			val { memberOf, union, intersection, difference, add, addl,
95 :			makeset, eq = sameSet, ... } =
96 :			Set.gen { eq = equal, lt = lt }
97 :
98 :			val fold = Set.fold
99 :			val empty = Set.empty
100 :			val isEmpty = Set.isEmpty
101 :			val makelist = Set.makelist
102 :			val singleton = Set.singleton
103 :
104 :			end

---

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