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/compile/generic.sml
ViewVC logotype

Annotation of /sml/trunk/src/cm/compile/generic.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 294 - (view) (download)

1 : blume 294 functor CompileGenericFn (structure CT: COMPILATION_TYPE) :> sig
2 :     type envdelta = CT.envdelta
3 :     val bnode : Primitive.configuration -> DependencyGraph.bnode -> envdelta
4 :     end = struct
5 :    
6 :     structure DG = DependencyGraph
7 :    
8 :     type envdelta = CT.envdelta
9 :    
10 :     infix o'
11 :     fun (f o' g) (x, y) = f (g x, y)
12 :    
13 :     fun farnode near (NONE, n) = CT.nofilter (near n)
14 :     | farnode near (SOME s, n) = CT.filter (near n, s)
15 :    
16 :     fun bnode c (DG.PNODE p) = CT.primitive c p
17 :     | bnode c (DG.BNODE { bininfo, localimports = li, globalimports = gi }) =
18 :     case CT.lookstable bininfo of
19 :     SOME e => e
20 :     | NONE => let
21 :     val ge = foldl (CT.layer o' farbnode c) (CT.pervasive c) gi
22 :     val le = foldl (CT.layer o' (CT.nofilter o bnode c)) ge li
23 :     val e = CT.dostable (bininfo, le, c)
24 :     in
25 :     CT.memostable (bininfo, e);
26 :     e
27 :     end
28 :    
29 :     and farbnode c = farnode (bnode c)
30 :    
31 :     fun snode c (DG.SNODE { smlinfo, localimports = li, globalimports = gi }) =
32 :     case CT.looksml smlinfo of
33 :     SOME e => e
34 :     | NONE => let
35 :     val ge = foldl (CT.layer o' farsbnode c) (CT.pervasive c) gi
36 :     val le = foldl (CT.layer o' (CT.nofilter o snode c)) ge li
37 :     val e = CT.dosml (smlinfo, le, c)
38 :     in
39 :     CT.memosml (smlinfo, e);
40 :     e
41 :     end
42 :    
43 :     and sbnode c (DG.SB_BNODE b) = bnode c b
44 :     | sbnode c (DG.SB_SNODE s) = snode c s
45 :    
46 :     and farsbnode c = farnode (sbnode c)
47 :     end

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