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 314 - (view) (download)

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

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