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/cm/semant/modname.sml
ViewVC logotype

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

Parent Directory Parent Directory | Revision Log 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