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 312 - (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 : blume 310 fun bn2statenv gp i = #1 (#stat (valOf (RecompTraversal.bnode gp i)))
44 :    
45 : blume 301 fun doall farsbnode (GroupGraph.GROUP { exports, ... }, gp) = let
46 :     fun one ((fsbn, _), false) = false
47 :     | one ((fsbn, _), true) =
48 :     isSome (farsbnode gp fsbn)
49 :     in
50 :     SymbolMap.foldl one true exports
51 :     end
52 :    
53 :     val recomp_group = doall RecompTraversal.farsbnode
54 :     fun exec_group arg =
55 : blume 303 (doall ExecTraversal.farsbnode arg)
56 :     before FullPersstate.rememberShared ()
57 : blume 312 fun make_group (arg as (GroupGraph.GROUP { required = rq, ... }, _)) =
58 :     (Say.say ("$Execute: required privileges are:\n" ::
59 :     map (fn s => (" " ^ s ^ "\n")) (StringSet.listItems rq));
60 :     if recomp_group arg then exec_group arg else false)
61 : blume 311
62 :     structure Stabilize = StabilizeFn (val bn2statenv = bn2statenv
63 :     val recomp = recomp_group)
64 :    
65 :     structure Parse = ParseFn (structure Stabilize = Stabilize)
66 : blume 276 in
67 : blume 274 structure CM = struct
68 : blume 301
69 : blume 310 fun run sflag f s = let
70 : blume 274 val c = AbsPath.cwdContext ()
71 :     val p = AbsPath.native { context = AbsPath.cwdContext (),
72 :     spec = s }
73 : blume 301 val { mod = basis, nomod = perv } =
74 :     split (#get GenericVC.EnvRef.pervasive ())
75 :     val corenv = #get GenericVC.EnvRef.core ()
76 :     val primconf = Primitive.configuration { basis = basis }
77 :     val param = { primconf = primconf,
78 :     fnpolicy = FilenamePolicy.default,
79 :     keep_going = false,
80 :     pervasive = perv,
81 :     corenv = corenv }
82 : blume 310 val g = Parse.parse param sflag p
83 : blume 274 in
84 : blume 303 Option.map f g
85 : blume 274 end
86 : blume 286
87 : blume 312 fun stabilize recursively = run (SOME recursively) ignore
88 : blume 310 val recomp = run NONE recomp_group
89 :     val make = run NONE make_group
90 : blume 274 end
91 :    
92 :     structure CMB = struct
93 :     fun setRetargetPervStatEnv x = ()
94 :     fun wipeOut () = ()
95 :     fun make' _ = ()
96 :     end
97 : blume 276 end
98 : blume 274 end
99 :    
100 :     signature CMTOOLS = sig end
101 :     signature COMPILATION_MANAGER = sig end

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