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

Annotation of /sml/trunk/src/cm/link.sml

Parent Directory Parent Directory | Revision Log Revision Log


Revision 302 - (view) (download)

1 : blume 274 (* dummy implementation of functor LinkCM *)
2 :    
3 : blume 301 functor LinkCM (structure HostMachDepVC : MACHDEP_VC) = struct
4 : blume 274
5 : blume 276 local
6 :     structure YaccTool = YaccTool
7 :     structure LexTool = LexTool
8 :     structure BurgTool = BurgTool
9 :     val _ = EnvConfig.init ()
10 : blume 301
11 :     structure E = GenericVC.Environment
12 :     structure SE = GenericVC.StaticEnv
13 :     structure CMSE = GenericVC.CMStaticEnv
14 :     structure S = GenericVC.Symbol
15 :    
16 :     fun split e = let
17 :     val sym = E.symbolicPart e
18 :     val dyn = E.dynamicPart e
19 :     val stat = E.staticPart e
20 :     val bstat = CMSE.unCM stat
21 :     fun f ((s, b), (mods, nomods)) =
22 :     case S.nameSpace s of
23 :     (S.STRspace | S.SIGspace | S.FCTspace | S.FSIGspace) =>
24 :     (SE.bind (s, b, mods), nomods)
25 :     | _ => (mods, SE.bind (s, b, nomods))
26 :     val (bmods, bnomods) = SE.fold f (SE.empty, SE.empty) bstat
27 :     val mods = CMSE.CM bmods
28 :     val nomods = CMSE.CM bnomods
29 :     fun mk s = E.mkenv { static = s, dynamic = dyn, symbolic = sym }
30 :     in
31 :     { mod = mk mods, nomod = mk nomods }
32 :     end
33 :    
34 :     structure FullPersstate =
35 :     FullPersstateFn (structure MachDepVC = HostMachDepVC)
36 :    
37 :     structure Recomp = RecompFn (structure PS = FullPersstate)
38 :     structure Exec = ExecFn (structure PS = FullPersstate)
39 :    
40 :     structure RecompTraversal = CompileGenericFn (structure CT = Recomp)
41 :     structure ExecTraversal = CompileGenericFn (structure CT = Exec)
42 :    
43 :     fun doall farsbnode (GroupGraph.GROUP { exports, ... }, gp) = let
44 :     fun one ((fsbn, _), false) = false
45 :     | one ((fsbn, _), true) =
46 :     isSome (farsbnode gp fsbn)
47 :     in
48 :     SymbolMap.foldl one true exports
49 :     end
50 :    
51 :     val recomp_group = doall RecompTraversal.farsbnode
52 :     fun exec_group arg =
53 :     (DynTStamp.new ();
54 : blume 302 (doall ExecTraversal.farsbnode arg)
55 :     before FullPersstate.forgetNonShared ())
56 : blume 301 fun make_group arg =
57 :     (if recomp_group arg then exec_group arg else false)
58 : blume 276 in
59 : blume 274 structure CM = struct
60 : blume 301
61 :     fun run f s = let
62 : blume 274 val c = AbsPath.cwdContext ()
63 :     val p = AbsPath.native { context = AbsPath.cwdContext (),
64 :     spec = s }
65 : blume 301 val { mod = basis, nomod = perv } =
66 :     split (#get GenericVC.EnvRef.pervasive ())
67 :     val corenv = #get GenericVC.EnvRef.core ()
68 :     val primconf = Primitive.configuration { basis = basis }
69 :     val param = { primconf = primconf,
70 :     fnpolicy = FilenamePolicy.default,
71 :     keep_going = false,
72 :     pervasive = perv,
73 :     corenv = corenv }
74 : blume 274 in
75 : blume 301 Say.vsay "[starting]\n";
76 :     Option.map f (CMParse.parse param p)
77 : blume 274 end
78 : blume 286
79 : blume 301 val parse = run #1
80 :     val recomp = run recomp_group
81 :     val make = run make_group
82 : blume 274 end
83 :    
84 :     structure CMB = struct
85 :     fun setRetargetPervStatEnv x = ()
86 :     fun wipeOut () = ()
87 :     fun make' _ = ()
88 :     end
89 : blume 276 end
90 : blume 274 end
91 :    
92 :     signature CMTOOLS = sig end
93 :     signature COMPILATION_MANAGER = sig end

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