Annotation of /sml/trunk/src/cm/bootstrap/mkprimperv.sml

Parent Directory | Revision Log

---

Revision 324 - (view) (download)

1 :	blume	324	structure MkPrimPerv = struct
2 :
3 :			structure S = GenericVC.Source
4 :			structure EM = GenericVC.ErrorMsg
5 :			structure SM = GenericVC.SourceMap
6 :
7 :			fun mk (gp: GeneralParams.info) specgroup = let
8 :			val context = AbsPath.relativeContext (AbsPath.dir specgroup)
9 :			val specname = AbsPath.name specgroup
10 :			val stream = TextIO.openIn specname
11 :			val errcons = #errcons gp
12 :			val source = S.newSource (specname, 1, stream, false, errcons)
13 :			val sourceMap = #sourceMap source
14 :
15 :			val _ = GroupReg.register (#groupreg gp) (specgroup, source)
16 :
17 :			fun error r m = EM.error source r EM.COMPLAIN m EM.nullErrorBody
18 :
19 :			fun lineIn pos = let
20 :			val line = TextIO.inputLine stream
21 :			val len = size line
22 :			val newpos = pos + len
23 :			val _ = GenericVC.SourceMap.newline sourceMap newpos
24 :			fun sep c = Char.isSpace c orelse Char.contains "(),=;" c
25 :			in
26 :			if line = "" then NONE
27 :			else if String.sub (line, 0) = #"#" then SOME ([], newpos)
28 :			else SOME (String.tokens sep line, newpos)
29 :			end
30 :
31 :			val boguspid = GenericVC.PersStamps.fromBytes
32 :			(Byte.stringToBytes "0123456789abcdef")
33 :			fun bogus n = { name = n, env = GenericVC.Environment.emptyEnv,
34 :			pidInfo = { statpid = boguspid, sympid = boguspid,
35 :			ctxt = GenericVC.CMStaticEnv.empty } }
36 :
37 :			fun loop (split, m, fl, pos) =
38 :			case lineIn pos of
39 :			NONE => (error (pos, pos) "unexpected end of file"; NONE)
40 :			| SOME (line, newpos) => let
41 :			val error = error (pos, newpos)
42 :			fun look n =
43 :			case StringMap.find (m, n) of
44 :			SOME x => x
45 :			| NONE => (error ("undefined: " ^ n); bogus n)
46 :			fun sml spec = let
47 :			val sourcepath = AbsPath.standard (#pcmode (#param gp))
48 :			{ context = context, spec = spec }
49 :			in
50 :			SmlInfo.info gp { sourcepath = sourcepath,
51 :			group = (specgroup, (pos, newpos)),
52 :			share = NONE }
53 :			end
54 :
55 :			fun report n = let
56 :			val outfile =
57 :			AbsPath.name (SmlInfo.binpath (sml n)) ^ ".PID"
58 :			val s = TextIO.openOut outfile
59 :			val p = #statpid (#pidInfo (look n))
60 :			in
61 :			TextIO.output (s, GenericVC.PersStamps.toHex p ^ "\n");
62 :			TextIO.closeOut s
63 :			end
64 :
65 :			fun compile (name, file, args) = Dummy.f ()
66 :			in
67 :			case line of
68 :			[] => loop (split, m, fl, newpos)
69 :			| ["split"] => loop (true, m, fl, newpos)
70 :			| ["nosplit"] => loop (false, m, fl, newpos)
71 :			| ["reportPid", name] =>
72 :			(report name;
73 :			loop (split, m, fl, newpos))
74 :			| ("let" :: name :: file :: args) =>
75 :			loop (split, compile (name, file, args),
76 :			file :: fl, newpos)
77 :			| ("return" :: core :: pervasive :: primitives) =>
78 :			SOME { core = #env (look core),
79 :			pervasive = #env (look pervasive),
80 :			primitives = foldr
81 :			(fn (n, l) => look n :: l)
82 :			[] primitives }
83 :			| _ => (error "malformed line"; NONE)
84 :			end
85 :			in
86 :			loop (false, StringMap.empty, [], 2) (* consistent with ml-lex bug? *)
87 :			end
88 :			end

---

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