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/statenv/genmap.sml
ViewVC logotype

Annotation of /sml/trunk/src/compiler/Semant/statenv/genmap.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 587 - (view) (download)

1 : blume 587 (*
2 :     * Rapid modmap generation based on modtrees.
3 :     * (Modtrees are embedded into static environments during unpickling.
4 :     * This module cannot deal with environments that did not come out
5 :     * of the unpickler.)
6 :     *
7 :     * March 2000, Matthias Blume
8 :     *)
9 :     structure GenModIdMap : sig
10 :     val mkMap : StaticEnv.staticEnv -> ModuleId.tmap
11 :     val mkMap' : StaticEnv.staticEnv * ModuleId.tmap -> ModuleId.tmap
12 :     end = struct
13 :    
14 :     structure M = Modules
15 :     structure MI = ModuleId
16 :    
17 :     fun mkMap' (se: StaticEnv.staticEnv, initial) = let
18 :     fun tree (t, m) = let
19 :     fun rc (r, stubOf, treeOf, part, id, insert, look) = let
20 :     val i = id r
21 :     in
22 :     case look (m, i) of
23 :     SOME _ => m
24 :     | NONE => let
25 :     val m' = insert (m, i, part)
26 :     in
27 :     case stubOf part of
28 :     NONE => ErrorMsg.impossible "ModIdSet:no stubinfo"
29 :     | SOME stb => tree (treeOf stb, m')
30 :     end
31 :     end
32 :     in
33 :     case t of
34 :     M.TYCNODE r => MI.insertTyc (m, MI.tycId r, r)
35 :     | M.SIGNODE r =>
36 :     rc (r, #stub, #tree, r, MI.sigId, MI.insertSig, MI.lookSig)
37 :     | M.STRNODE r =>
38 :     rc (r, #stub, #tree, #rlzn r,
39 :     MI.strId, MI.insertStr, MI.lookStr)
40 :     | M.FCTNODE r =>
41 :     rc (r, #stub, #tree, #rlzn r,
42 :     MI.fctId, MI.insertFct, MI.lookFct)
43 :     | M.ENVNODE r =>
44 :     rc (r, #stub, #tree, r, MI.envId, MI.insertEnv, MI.lookEnv)
45 :     | M.BRANCH l => foldl tree m l
46 :     end
47 :     fun bnd ((_, (_, SOME t)), m) = tree (t, m)
48 :     | bnd (_, m) = m
49 :     in
50 :     Env.fold bnd initial se
51 :     end
52 :    
53 :     fun mkMap se = mkMap' (se, MI.emptyTmap)
54 :     end

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