Annotation of /sml/trunk/src/ml-nlffigen/gen.sml

Parent Directory | Revision Log

---

Revision 836 - (view) (download)

1 :	blume	828	(*
2 :			* gen.sml - Generating and pretty-printing ML code implementing a
3 :			* typed interface to a C program.
4 :			*
5 :			* (C) 2001, Lucent Technologies, Bell Labs
6 :			*
7 :			* author: Matthias Blume (blume@research.bell-labs.com)
8 :			*)
9 :			local
10 :			val program = "ml-ffigen"
11 :			val version = "0.1"
12 :			val author = "Matthias Blume"
13 :			val email = "blume@research.bell-labs.com"
14 :			structure S = Spec
15 :			in
16 :
17 :			structure Gen :> sig
18 :			val gen : { idlfile: string,
19 :			idlsource: string,
20 :			sigfile: string,
21 :			strfile: string,
22 :			cmfile: string,
23 :			signame: string,
24 :			strname: string,
25 :			allSU: bool,
26 :			lambdasplit: string option,
27 :			wid: int } -> unit
28 :			end = struct
29 :
30 :			structure P = PrettyPrint
31 :			structure PP = P.PP
32 :			val Tuple = P.TUPLE
33 :			val Con = P.CON
34 :			val Arrow = P.ARROW
35 :			val Type = P.Type
36 :			val St = P.St
37 :			val Un = P.Un
38 :			val Unit = P.Unit
39 :			val ETuple = P.ETUPLE
40 :			val EVar = P.EVAR
41 :			val EApp = P.EAPP
42 :			val EConstr = P.ECONSTR
43 :			val ESeq = P.ESEQ
44 :			fun EWord w = EVar ("0wx" ^ Word.toString w)
45 :			fun EInt i = EVar (Int.toString i)
46 :			fun EString s = EVar (concat ["\"", String.toString s, "\""])
47 :
48 :			val dontedit = "(* This file has been generated automatically. \
49 :			\DO NOT EDIT! *)"
50 :			fun mkCredits src = concat ["(* [from ", src, " by ", author, "'s ",
51 :			program, " (version ", version, ")] *)"]
52 :			val commentsto = concat ["(* Send comments and suggestions to ",
53 :			email, ". Thanks! *)"]
54 :
55 :			fun gen args = let
56 :
57 :			val { idlfile, idlsource,
58 :			sigfile, strfile, cmfile,
59 :			signame, strname,
60 :			allSU, lambdasplit,
61 :			wid } = args
62 :
63 :			val credits = mkCredits idlfile
64 :
65 :			val astbundle = ParseToAst.fileToAst'
66 :			TextIO.stdErr
67 :			(GenSizes.sizes, State.INITIAL)
68 :			idlsource
69 :
70 :			val spec = AstToSpec.build (astbundle, GenSizes.sizes, idlfile, allSU)
71 :
72 :			val { structs, unions, gvars, gfuns, gtys } = spec
73 :
74 :			fun openPP f =
75 :			PP.openStream (SimpleTextIODev.openDev { dst = TextIO.openOut f,
76 :			wid = wid })
77 :
78 :			exception Incomplete
79 :
80 :			fun get_struct t =
81 :			case List.find (fn s => #tag s = t) structs of
82 :			SOME x => x
83 :			| NONE => raise Incomplete
84 :			fun get_union t =
85 :			case List.find (fn u => #tag u = t) unions of
86 :			SOME x => x
87 :			| NONE => raise Incomplete
88 :
89 :			fun stem S.SCHAR = "schar"
90 :			| stem S.UCHAR = "uchar"
91 :			| stem S.SINT = "sint"
92 :			| stem S.UINT = "uint"
93 :			| stem S.SSHORT = "sshort"
94 :			| stem S.USHORT = "ushort"
95 :			| stem S.SLONG = "slong"
96 :			| stem S.ULONG = "ulong"
97 :			| stem S.FLOAT = "float"
98 :			| stem S.DOUBLE = "double"
99 :			| stem S.VOIDPTR = "voidptr"
100 :			| stem _ = raise Fail "bad stem"
101 :
102 :			fun sinsert (s: string, l) =
103 :			case List.find (fn s' => s = s') l of
104 :			SOME _ => l
105 :			| NONE => s :: l
106 :
107 :			(* We don't expect many different function pointer types or
108 :			* incomplete types in any given C interface, so using linear
109 :			* lists here is probably ok. *)
110 :			val (fptr_types, incomplete_structs, incomplete_unions) = let
111 :			fun ty ((S.SCHAR | S.UCHAR | S.SINT | S.UINT |
112 :			S.SSHORT | S.USHORT |
113 :			S.SLONG | S.ULONG | S.FLOAT | S.DOUBLE |
114 :			S.VOIDPTR), a) = a
115 :			| ty (S.STRUCT t, a as (f, s, u)) =
116 :			((ignore (get_struct t); a)
117 :			handle Incomplete => (f, sinsert (t, s), u))
118 :			| ty (S.UNION t, a as (f, s, u)) =
119 :			((ignore (get_union t); a)
120 :			handle Incomplete => (f, s, sinsert (t, u)))
121 :			| ty ((S.PTR (_, t) | S.ARR { t, ... }), a) = ty (t, a)
122 :			| ty (S.FPTR cft, a as (f, s, u)) =
123 :			if List.exists (fn (cft', _) => cft = cft') f then a
124 :			else ((cft, length f) :: f, s, u)
125 :			fun fs (S.OFIELD { spec = (_, t), ... }, a) = ty (t, a)
126 :			| fs (_, a) = a
127 :			fun f ({ name, spec }, a) = fs (spec, a)
128 :			fun s ({ tag, size, anon, fields }, a) = foldl f a fields
129 :			fun u ({ tag, size, anon, largest, all }, a) =
130 :			foldl f a (largest :: all)
131 :			fun gty ({ name, spec }, a) = ty (spec, a)
132 :			fun gvar ({ name, spec = (_, t) }, a) = ty (t, a)
133 :			fun gfun ({ name, spec }, a) = ty (S.FPTR spec, a)
134 :			in
135 :			foldl gfun (foldl gvar
136 :			(foldl gty (foldl u (foldl s ([], [], []) structs)
137 :			unions)
138 :			gtys)
139 :			gvars)
140 :			gfuns
141 :			end
142 :
143 :			fun incomplete t = let
144 :			fun decide (K, tag: Spec.tag, l) =
145 :			if List.exists (fn tag' => tag = tag') l then
146 :			SOME (K, tag)
147 :			else NONE
148 :			in
149 :			case t of
150 :			S.STRUCT tag => decide ("S", tag, incomplete_structs)
151 :			| S.UNION tag => decide ("U", tag, incomplete_unions)
152 :			| _ => NONE
153 :			end
154 :
155 :	blume	836	val cgtys = List.filter (not o isSome o incomplete o #spec) gtys
156 :
157 :	blume	828	fun istruct (K, tag) = concat ["I_", K, "_", tag]
158 :
159 :			fun rwro S.RW = Type "rw"
160 :			| rwro S.RO = Type "ro"
161 :
162 :			fun dim_ty 0 = Type "dec"
163 :			| dim_ty n = Con ("dg" ^ Int.toString (n mod 10),
164 :			[dim_ty (n div 10)])
165 :
166 :	blume	831	fun Suobj'rw p sut = Con ("su_obj" ^ p, [sut, Type "rw"])
167 :	blume	828	fun Suobj'ro sut = Con ("su_obj'", [sut, Type "ro"])
168 :			fun Suobj''c sut = Con ("su_obj'", [sut, Type "'c"])
169 :
170 :			fun wtn_f_fptr_p p { args, res } = let
171 :			fun topty (S.STRUCT t) = Suobj'ro (St t)
172 :			| topty (S.UNION t) = Suobj'ro (Un t)
173 :			| topty t = wtn_ty' t
174 :			val (res_t, extra_arg_t) =
175 :			case res of
176 :			NONE => (Unit, [])
177 :			| SOME (S.STRUCT t) => let
178 :	blume	831	val ot = Suobj'rw "'" (St t)
179 :	blume	828	in
180 :			(ot, [ot])
181 :			end
182 :			| SOME (S.UNION t) => let
183 :	blume	831	val ot = Suobj'rw "'" (Un t)
184 :	blume	828	in
185 :			(ot, [ot])
186 :			end
187 :			| SOME t => (topty t, [])
188 :			val arg_tl = extra_arg_t @ map topty args
189 :			val dom_t = Tuple arg_tl
190 :			val fct_t = Arrow (dom_t, res_t)
191 :			in
192 :			(Con ("fptr" ^ p, [fct_t]), fct_t)
193 :			end
194 :
195 :			and wtn_f_ty_p p (t as (S.SCHAR | S.UCHAR | S.SINT | S.UINT |
196 :			S.SSHORT | S.USHORT | S.SLONG | S.ULONG |
197 :			S.FLOAT | S.DOUBLE | S.VOIDPTR)) =
198 :			(Type (stem t), Unit)
199 :			| wtn_f_ty_p p (S.STRUCT t) = (Con ("su", [St t]), Unit)
200 :			| wtn_f_ty_p p (S.UNION t) = (Con ("su", [Un t]), Unit)
201 :			| wtn_f_ty_p p (S.PTR (c, t)) =
202 :			(case incomplete t of
203 :			SOME (K, tag) =>
204 :			(Con (concat [istruct (K, tag), ".iptr", p], [rwro c]), Unit)
205 :			| NONE => let
206 :			val (w, f) = wtn_f_ty t
207 :			in
208 :			(Con ("ptr" ^ p, [w, f, rwro c]), f)
209 :			end)
210 :			| wtn_f_ty_p p (S.ARR { t, d, ... }) = let
211 :			val (w, f) = wtn_f_ty t
212 :			in
213 :	blume	836	(Con ("arr", [w, dim_ty d]), f)
214 :	blume	828	end
215 :			| wtn_f_ty_p p (S.FPTR spec) = wtn_f_fptr_p p spec
216 :
217 :			and wtn_f_ty t = wtn_f_ty_p "" t
218 :
219 :			and wtn_ty t = #1 (wtn_f_ty t)
220 :
221 :			and wtn_ty' t = #1 (wtn_f_ty_p "'" t)
222 :
223 :			fun topfunc_ty p { args, res } = let
224 :			fun topty S.SCHAR = Type "MLRep.SChar.int"
225 :			| topty S.UCHAR = Type "MLRep.UChar.word"
226 :			| topty S.SINT = Type "MLRep.SInt.int"
227 :			| topty S.UINT = Type "MLRep.UInt.word"
228 :			| topty S.SSHORT = Type "MLRep.SShort.int"
229 :			| topty S.USHORT = Type "MLRep.UShort.word"
230 :			| topty S.SLONG = Type "MLRep.SLong.int"
231 :			| topty S.ULONG = Type "MLRep.ULong.word"
232 :			| topty S.FLOAT = Type "MLRep.Float.real"
233 :			| topty S.DOUBLE = Type "MLRep.Double.real"
234 :			| topty (S.STRUCT t) = Con ("su_obj" ^ p, [St t, Type "'c"])
235 :			| topty (S.UNION t) = Con ("su_obj" ^ p, [Un t, Type "'c"])
236 :			| topty t = #1 (wtn_f_ty_p p t)
237 :			val (res_t, extra_arg_t) =
238 :			case res of
239 :			NONE => (Unit, [])
240 :			| SOME (S.STRUCT t) => let
241 :	blume	831	val ot = Suobj'rw p (St t)
242 :	blume	828	in
243 :			(ot, [ot])
244 :			end
245 :			| SOME (S.UNION t) => let
246 :	blume	831	val ot = Suobj'rw p (Un t)
247 :	blume	828	in
248 :			(ot, [ot])
249 :			end
250 :			| SOME t => (topty t, [])
251 :			in
252 :			Arrow (Tuple (extra_arg_t @ map topty args), res_t)
253 :			end
254 :
255 :			fun rti_ty t = let
256 :			val (w, f) = wtn_f_ty t
257 :			in
258 :			Con ("T.typ", [w, f])
259 :			end
260 :
261 :			fun obj_ty p (t, c) = let
262 :			val (w, f) = wtn_f_ty t
263 :			in
264 :			Con ("obj" ^ p, [w, f, c])
265 :			end
266 :
267 :			fun cro S.RW = Type "'c"
268 :			| cro S.RO = Type "ro"
269 :
270 :			fun dim_val n = let
271 :			fun build 0 = EVar "dec"
272 :			| build n = EApp (build (n div 10),
273 :			EVar ("dg" ^ Int.toString (n mod 10)))
274 :			in
275 :			EApp (build n, EVar "dim")
276 :			end
277 :
278 :			local
279 :			fun simple v = EVar ("T." ^ v)
280 :			in
281 :			fun rti_val (t as (S.SCHAR | S.UCHAR | S.SINT | S.UINT |
282 :			S.SSHORT | S.USHORT | S.SLONG | S.ULONG |
283 :			S.FLOAT | S.DOUBLE | S.VOIDPTR)) =
284 :			simple (stem t)
285 :			| rti_val (S.STRUCT t) = EVar (concat ["S_", t, ".typ"])
286 :			| rti_val (S.UNION t) = EVar (concat ["U_", t, ".typ"])
287 :			| rti_val (S.FPTR cft) =
288 :			(case List.find (fn x => #1 x = cft) fptr_types of
289 :			SOME (_, i) => EVar ("fptr_rti_" ^ Int.toString i)
290 :			| NONE => raise Fail "fptr type missing")
291 :			| rti_val (S.PTR (S.RW, t)) =
292 :			(case incomplete t of
293 :			SOME (K, tag) =>
294 :			EVar (istruct (K, tag) ^ ".typ'rw")
295 :			| NONE => EApp (EVar "T.pointer", rti_val t))
296 :			| rti_val (S.PTR (S.RO, t)) =
297 :			(case incomplete t of
298 :			SOME (K, tag) =>
299 :			EVar (istruct (K, tag) ^ ".typ'ro")
300 :			| NONE => EApp (EVar "T.ro",
301 :			EApp (EVar "T.pointer", rti_val t)))
302 :			| rti_val (S.ARR { t, d, ... }) =
303 :			EApp (EVar "T.arr", ETuple [rti_val t, dim_val d])
304 :			end
305 :
306 :			fun do_sig_file () = let
307 :
308 :			val sigpp = openPP sigfile
309 :
310 :			fun nl () = PP.newline sigpp
311 :			fun str s = PP.string sigpp s
312 :			fun sp () = PP.space sigpp 1
313 :			fun nsp () = PP.nbSpace sigpp 1
314 :			fun Box a = PP.openBox sigpp (PP.Abs a)
315 :			fun HBox () = PP.openHBox sigpp
316 :			fun HOVBox a = PP.openHOVBox sigpp (PP.Abs a)
317 :			fun VBox a = PP.openVBox sigpp (PP.Abs a)
318 :			fun endBox () = PP.closeBox sigpp
319 :			fun ppty t = P.ppType sigpp t
320 :
321 :			fun pr_su_tag t =
322 :			(nl (); HBox (); str "type"; sp (); ppty t; endBox ())
323 :
324 :			fun pr_struct_tag { tag, size, anon, fields } =
325 :			pr_su_tag (St tag)
326 :
327 :			fun pr_union_tag { tag, size, anon, largest, all } =
328 :			pr_su_tag (Un tag)
329 :
330 :			fun pr_decl (keyword, connector) (v, t) =
331 :			(nl (); HOVBox 4; str keyword; nsp (); str v; nsp ();
332 :			str connector; sp (); ppty t; endBox ())
333 :
334 :			val pr_tdef = pr_decl ("type", "=")
335 :			val pr_vdecl = pr_decl ("val", ":")
336 :
337 :			fun pr_su_structure (StUn, K, su, tag, fields) = let
338 :
339 :			fun pr_field_typ { name, spec = S.OFIELD { spec = (c, t),
340 :			synthetic = false,
341 :			offset } } =
342 :			pr_tdef ("t_f_" ^ name, wtn_ty t)
343 :			| pr_field_typ _ = ()
344 :
345 :			fun pr_field_rti { name, spec = S.OFIELD { spec = (c, t),
346 :			synthetic = false,
347 :			offset } } =
348 :			pr_vdecl ("typ_f_" ^ name, rti_ty t)
349 :			| pr_field_rti _ = ()
350 :
351 :			fun pr_field_acc0 (name, p, t) =
352 :			pr_vdecl (concat ["f_", name, p],
353 :			Arrow (Con ("su_obj" ^ p, [StUn tag, Type "'c"]),
354 :			t))
355 :
356 :			fun pr_bf_acc (name, p, sg, c) =
357 :			pr_field_acc0 (name, p, Con (sg ^ "bf", [cro c]))
358 :
359 :			fun pr_field_acc p { name, spec = S.OFIELD { spec = (c, t),
360 :			synthetic = false,
361 :			offset } } =
362 :			pr_field_acc0 (name, p, obj_ty p (t, cro c))
363 :			| pr_field_acc p { name, spec = S.OFIELD _ } = ()
364 :			| pr_field_acc p { name, spec = S.SBF bf } =
365 :			pr_bf_acc (name, p, "s", #constness bf)
366 :			| pr_field_acc p { name, spec = S.UBF bf } =
367 :			pr_bf_acc (name, p, "u", #constness bf)
368 :			in
369 :			nl ();
370 :			nl (); str (concat ["structure ", K, "_", tag,
371 :			" : sig (* ", su, " ", tag, " *)"]);
372 :			Box 4;
373 :			pr_tdef ("tag", StUn tag);
374 :			nl ();
375 :			nl (); str (concat ["(* size for this ", su, " *)"]);
376 :			pr_vdecl ("size", Con ("S.size", [Con ("su", [StUn tag])]));
377 :			nl ();
378 :			nl (); str (concat ["(* RTI for this ", su, " *)"]);
379 :			pr_vdecl ("typ", Con ("T.su_typ", [StUn tag]));
380 :			nl ();
381 :			nl (); str "(* witness types for fields *)";
382 :			app pr_field_typ fields;
383 :			nl ();
384 :			nl (); str "(* RTI for fields *)";
385 :			app pr_field_rti fields;
386 :			nl ();
387 :			nl (); str "(* field accessors *)";
388 :			app (pr_field_acc "") fields;
389 :			nl ();
390 :			nl (); str "(* field accessors (lightweight variety) *)";
391 :			app (pr_field_acc "'") fields;
392 :			endBox ();
393 :			nl (); str (concat ["end (* structure ", K, "_", tag, " *)"])
394 :			end
395 :
396 :			fun pr_struct_structure { tag, size, anon, fields } =
397 :			pr_su_structure (St, "S", "struct", tag, fields)
398 :			fun pr_union_structure { tag, size, anon, largest, all } =
399 :			pr_su_structure (Un, "U", "union", tag, all)
400 :
401 :			fun pr_gty_rti { name, spec } =
402 :			pr_vdecl ("typ_t_" ^ name, rti_ty spec)
403 :
404 :			fun pr_gvar_obj { name, spec = (c, t) } =
405 :			pr_vdecl ("g_" ^ name, Arrow (Unit, obj_ty "" (t, rwro c)))
406 :
407 :			fun pr_gfun_rti { name, spec } =
408 :			pr_vdecl ("typ_fn_" ^ name, rti_ty (S.FPTR spec))
409 :
410 :			fun pr_gfun_fptr { name, spec } =
411 :			pr_vdecl ("fptr_fn_" ^ name,
412 :			Arrow (Unit, wtn_ty (S.FPTR spec)))
413 :
414 :			fun pr_gfun_func p { name, spec } =
415 :			pr_vdecl (concat ["fn_", name, p], topfunc_ty p spec)
416 :
417 :			fun pr_isu (K, tag) =
418 :			(nl ();
419 :			str (concat ["structure ", istruct (K, tag),
420 :			" : POINTER_TO_INCOMPLETE_TYPE"]))
421 :			fun pr_istruct tag = pr_isu ("S", tag)
422 :			fun pr_iunion tag = pr_isu ("U", tag)
423 :			in
424 :			(* Generating the signature file... *)
425 :			str dontedit;
426 :			nl (); str credits;
427 :			nl (); str commentsto;
428 :			nl (); str "local open C.Dim C in";
429 :			nl (); str (concat ["signature ", signame, " = sig"]);
430 :			VBox 4;
431 :			app pr_istruct incomplete_structs;
432 :			app pr_iunion incomplete_unions;
433 :			app pr_struct_tag structs;
434 :			app pr_union_tag unions;
435 :			app pr_struct_structure structs;
436 :			app pr_union_structure unions;
437 :	blume	836	if not (List.null cgtys) then
438 :	blume	828	(nl (); nl (); str "(* RTI for typedefs *)";
439 :	blume	836	app pr_gty_rti cgtys)
440 :	blume	828	else ();
441 :			if not (List.null gvars) then
442 :			(nl (); nl (); str "(* object handles for global variables *)";
443 :			app pr_gvar_obj gvars)
444 :			else ();
445 :			if not (List.null gfuns) then
446 :			(nl (); nl (); str "(* RTI for global function(-pointer)s *)";
447 :			app pr_gfun_rti gfuns;
448 :			nl (); nl (); str "(* global function pointers *)";
449 :			app pr_gfun_fptr gfuns;
450 :			nl (); nl (); str "(* global functions *)";
451 :			app (pr_gfun_func "'") gfuns;
452 :			app (pr_gfun_func "") gfuns)
453 :			else ();
454 :			endBox ();
455 :			nl (); str (concat ["end (* signature ", signame, " *)"]);
456 :			nl (); str "end (* local *)";
457 :			nl ();
458 :
459 :			PP.closeStream sigpp
460 :			end
461 :
462 :			fun do_fct_file () = let
463 :			val strpp = openPP strfile
464 :
465 :			fun nl () = PP.newline strpp
466 :			fun str s = PP.string strpp s
467 :			fun sp () = PP.space strpp 1
468 :			fun nsp () = PP.nbSpace strpp 1
469 :			fun Box a = PP.openBox strpp (PP.Abs a)
470 :			fun HBox () = PP.openHBox strpp
471 :			fun HOVBox a = PP.openHOVBox strpp (PP.Abs a)
472 :			fun VBox a = PP.openVBox strpp (PP.Abs a)
473 :			fun endBox () = PP.closeBox strpp
474 :			fun ppty t = P.ppType strpp t
475 :			fun ppExp e = P.ppExp strpp e
476 :			fun ppFun x = P.ppFun strpp x
477 :
478 :			fun pr_fdef (f, args, res) = (nl (); ppFun (f, args, res))
479 :
480 :			fun pr_def_t (sep, keyword, connector) (v, t) =
481 :			(sep ();
482 :			HOVBox 4; str keyword; nsp (); str v; nsp (); str connector;
483 :			sp (); ppty t; endBox ())
484 :
485 :			val pr_vdecl = pr_def_t (fn () => (), "val", ":")
486 :
487 :			val pr_tdef = pr_def_t (nl, "type", "=")
488 :
489 :			fun pr_vdef (v, e) =
490 :			(nl ();
491 :			HOVBox 4; str "val"; nsp (); str v; nsp (); str "=";
492 :			sp (); ppExp e; endBox ())
493 :
494 :			fun pr_su_tag (su, tag, false) =
495 :			let fun build [] = Type su
496 :			| build (h :: tl) = Con ("t_" ^ String.str h, [build tl])
497 :			in
498 :			pr_tdef (concat [su, "_", tag],
499 :			build (rev (String.explode tag)))
500 :			end
501 :			| pr_su_tag (su, tag, true) =
502 :			(nl (); str "local";
503 :			VBox 4;
504 :			nl (); str
505 :			"structure X :> sig type t end = struct type t = unit end";
506 :			endBox ();
507 :			nl (); str "in";
508 :			VBox 4;
509 :			pr_tdef (concat [su, "_", tag],
510 :			Type "X.t");
511 :			endBox ();
512 :			nl (); str "end")
513 :
514 :			fun pr_struct_tag { tag, size, anon, fields } =
515 :			pr_su_tag ("s", tag, anon)
516 :			fun pr_union_tag { tag, size, anon, largest, all } =
517 :			pr_su_tag ("u", tag, anon)
518 :
519 :			fun pr_su_tag_copy (k, tag) = let
520 :			val tn = concat [k, "_", tag]
521 :			in
522 :			pr_tdef (tn, Type tn)
523 :			end
524 :
525 :			fun pr_struct_tag_copy { tag, size, anon, fields } =
526 :			pr_su_tag_copy ("s", tag)
527 :			fun pr_union_tag_copy { tag, size, anon, largest, all } =
528 :			pr_su_tag_copy ("u", tag)
529 :
530 :			fun pr_fptr_rti ({ args, res }, i) = let
531 :
532 :			(* cproto encoding *)
533 :			fun List t = Con ("list", [t])
534 :			val Real = Type "real"
535 :			val Char = Type "char"
536 :			val Word8 = Type "Word8.word"
537 :			val Int31 = Type "Int31.int"
538 :			val Word31 = Type "Word31.word"
539 :			val Int32 = Type "Int32.int"
540 :			val Word32 = Type "Word32.word"
541 :			val String = Type "string"
542 :			val Exn = Type "exn"
543 :
544 :			(* see src/compiler/Semant/types/cproto.sml for these... *)
545 :			val E_double = Real
546 :			val E_float = List Real
547 :			val E_schar = Char
548 :			val E_uchar = Word8
549 :			val E_sint = Int31
550 :			val E_uint = Word31
551 :			val E_slong = Int32
552 :			val E_ulong = Word32
553 :			val E_sshort = List Char
554 :			val E_ushort = List Word8
555 :			val E_sllong = List Int32 (* not used yet *)
556 :			val E_ullong = List Word32(* not used yet *)
557 :			val E_ptr = String
558 :			val E_nullstruct = Exn
559 :
560 :			fun encode S.DOUBLE = E_double
561 :			| encode S.FLOAT = E_float
562 :			| encode S.SCHAR = E_schar
563 :			| encode S.UCHAR = E_uchar
564 :			| encode S.SINT = E_sint
565 :			| encode S.UINT = E_uint
566 :			| encode S.SSHORT = E_sshort
567 :			| encode S.USHORT = E_ushort
568 :			| encode S.SLONG = E_slong
569 :			| encode S.ULONG = E_ulong
570 :			| encode (S.PTR _ | S.VOIDPTR | S.FPTR _) = E_ptr
571 :			| encode (S.ARR _) = raise Fail "unexpected array"
572 :			| encode (S.STRUCT t) =
573 :			encode_fields (#fields (get_struct t))
574 :			| encode (S.UNION t) =
575 :			encode_fields [#largest (get_union t)]
576 :
577 :			and encode_fields fields = let
578 :			fun f0 (S.ARR { t, d = 0, ... }, a) = a
579 :			| f0 (S.ARR { t, d = 1, ... }, a) = f0 (t, a)
580 :			| f0 (S.ARR { t, d, esz }, a) =
581 :			f0 (t, f0 (S.ARR { t = t, d = d - 1, esz = esz }, a))
582 :			| f0 (t, a) = encode t :: a
583 :			fun f ({ spec = S.OFIELD { spec, ... }, name }, a) =
584 :			f0 (#2 spec, a)
585 :			| f (_, a) = a
586 :			val fel = foldr f [] fields
587 :			in
588 :			case fel of
589 :			[] => E_nullstruct
590 :			| fel => Tuple (Unit :: fel)
591 :			end
592 :
593 :			val e_arg = Tuple (Unit :: map encode args)
594 :			val e_res = case res of NONE => Unit | SOME t => encode t
595 :			val e_proto = Con ("list", [Arrow (e_arg, e_res)])
596 :
597 :			(* generating the call operation *)
598 :
599 :			(* low-level type used to communicate a value to the
600 :			* low-level call operation *)
601 :			fun mlty S.SCHAR = Type "CMemory.cc_schar"
602 :			| mlty S.UCHAR = Type "CMemory.cc_uchar"
603 :			| mlty S.SINT = Type "CMemory.cc_sint"
604 :			| mlty S.UINT = Type "CMemory.cc_uint"
605 :			| mlty S.SSHORT = Type "CMemory.cc_sshort"
606 :			| mlty S.USHORT = Type "CMemory.cc_ushort"
607 :			| mlty S.SLONG = Type "CMemory.cc_slong"
608 :			| mlty S.ULONG = Type "CMemory.cc_ulong"
609 :			| mlty S.FLOAT = Type "CMemory.cc_float"
610 :			| mlty S.DOUBLE = Type "CMemory.cc_double"
611 :			| mlty (S.VOIDPTR | S.PTR _ | S.FPTR _ |
612 :			S.STRUCT _) = Type "CMemory.cc_addr"
613 :			| mlty (S.ARR _ | S.UNION _) = raise Fail "unexpected type"
614 :
615 :			fun wrap (e, n) =
616 :			EApp (EVar ("CMemory.wrap_" ^ n),
617 :			EApp (EVar ("Cvt.ml_" ^ n), e))
618 :
619 :			fun vwrap e = EApp (EVar "CMemory.wrap_addr",
620 :			EApp (EVar "reveal", e))
621 :			fun fwrap e = EApp (EVar "CMemory.wrap_addr",
622 :			EApp (EVar "freveal", e))
623 :			fun pwrap e = EApp (EVar "CMemory.wrap_addr",
624 :			EApp (EVar "reveal",
625 :			EApp (EVar "Ptr.inject'", e)))
626 :			fun iwrap (K, tag, e) =
627 :			EApp (EVar "CMemory.wrap_addr",
628 :			EApp (EVar "reveal",
629 :			EApp (EVar (istruct (K, tag) ^ ".inject'"),
630 :			e)))
631 :
632 :			fun suwrap e = pwrap (EApp (EVar "Ptr.|&!", e))
633 :
634 :			(* this code is for passing structures in pieces
635 :			* (member-by-member); we don't use this and rather
636 :			* provide a pointer to the beginning of the struct *)
637 :
638 :			fun arglist ([], _) = ([], [])
639 :			| arglist (h :: tl, i) = let
640 :			val p = EVar ("x" ^ Int.toString i)
641 :			val (ta, ea) = arglist (tl, i + 1)
642 :			fun sel e = (mlty h :: ta, e :: ea)
643 :			in
644 :			case h of
645 :			(S.STRUCT _ | S.UNION _) => sel (suwrap p)
646 :			| (S.SCHAR | S.UCHAR | S.SINT | S.UINT |
647 :			S.SSHORT | S.USHORT | S.SLONG | S.ULONG |
648 :			S.FLOAT | S.DOUBLE) => sel (wrap (p, stem h))
649 :			| S.VOIDPTR => sel (vwrap p)
650 :			| S.PTR (_, t) =>
651 :			(case incomplete t of
652 :			SOME (K, tag) => sel (iwrap (K, tag, p))
653 :			| NONE => sel (pwrap p))
654 :			| S.FPTR _ => sel (fwrap p)
655 :			| S.ARR _ => raise Fail "unexpected array argument"
656 :			end
657 :
658 :			val (ml_res_t,
659 :			extra_arg_v, extra_arg_e, extra_ml_arg_t,
660 :			res_wrap) =
661 :			case res of
662 :			NONE => (Unit, [], [], [], fn r => r)
663 :			| SOME (S.STRUCT _ | S.UNION _) =>
664 :			(Unit,
665 :			[EVar "x0"],
666 :			[suwrap (EVar "x0")],
667 :			[Type "CMemory.cc_addr"],
668 :			fn r => ESeq (r, EVar "x0"))
669 :			| SOME t => let
670 :			fun unwrap n r =
671 :			EApp (EVar ("Cvt.c_" ^ n),
672 :			EApp (EVar ("CMemory.unwrap_" ^ n), r))
673 :			fun punwrap cast r =
674 :			EApp (EVar cast,
675 :			EApp (EVar "CMemory.unwrap_addr", r))
676 :			fun iunwrap (K, tag, t) r =
677 :			EApp (EApp (EVar (istruct (K, tag) ^
678 :			".project'"),
679 :			rti_val t),
680 :			punwrap "vcast" r)
681 :			val res_wrap =
682 :			case t of
683 :			(S.SCHAR | S.UCHAR | S.SINT | S.UINT |
684 :			S.SSHORT | S.USHORT | S.SLONG | S.ULONG |
685 :			S.FLOAT | S.DOUBLE) => unwrap (stem t)
686 :			| S.VOIDPTR => punwrap "vcast"
687 :			| S.FPTR _ => punwrap "fcast"
688 :			| t0 as S.PTR (_, t) =>
689 :			(case incomplete t of
690 :			SOME (K, tag) => iunwrap (K, tag, t0)
691 :			| NONE => punwrap "pcast")
692 :			| (S.STRUCT _ | S.UNION _ | S.ARR _) =>
693 :			raise Fail "unexpected result type"
694 :			in
695 :			(mlty t, [], [], [], res_wrap)
696 :			end
697 :
698 :			val (ml_args_tl, args_el) = arglist (args, 1)
699 :
700 :			val ml_args_t = Tuple (extra_ml_arg_t @ ml_args_tl)
701 :
702 :			val arg_vl =
703 :			rev (#1 (foldl (fn (_, (a, i)) =>
704 :			(EVar ("x" ^ Int.toString i) :: a,
705 :			i + 1)) ([], 1)
706 :			args))
707 :
708 :			val arg_e = ETuple (extra_arg_e @ args_el)
709 :			in
710 :			nl ();
711 :			str (concat ["val ", "fptr_rti_", Int.toString i, " = let"]);
712 :			VBox 4;
713 :			pr_vdef ("callop",
714 :			EConstr (EVar "RawMemInlineT.rawccall",
715 :			Arrow (Tuple [Type "Word32.word",
716 :			ml_args_t,
717 :			e_proto],
718 :			ml_res_t)));
719 :			pr_fdef ("mkcall",
720 :			[EVar "a", ETuple (extra_arg_v @ arg_vl)],
721 :			res_wrap (EApp (EVar "callop",
722 :			ETuple [EVar "a", arg_e,
723 :			EVar "nil"])));
724 :			endBox ();
725 :			nl (); str "in";
726 :			VBox 4;
727 :			nl (); ppExp (EConstr (EApp (EVar "mk_fptr_typ",
728 :			EVar "mkcall"),
729 :			rti_ty (S.FPTR { args = args,
730 :			res = res })));
731 :			endBox ();
732 :			nl (); str "end"
733 :			end
734 :
735 :			fun pr_su_structure (StUn, k, K, tag, size, fields) = let
736 :			fun rwro S.RW = "rw"
737 :			| rwro S.RO = "ro"
738 :			fun pr_field_typ { name, spec = S.OFIELD { spec = (c, t),
739 :			synthetic = false,
740 :			offset } } =
741 :			pr_tdef ("t_f_" ^ name, wtn_ty t)
742 :			| pr_field_typ _ = ()
743 :			fun pr_field_rti { name, spec = S.OFIELD { spec = (c, t),
744 :			synthetic = false,
745 :			offset } } =
746 :			pr_vdef ("typ_f_" ^ name, rti_val t)
747 :			| pr_field_rti _ = ()
748 :
749 :			fun pr_bf_acc (name, p, sign,
750 :			{ offset, constness, bits, shift }) =
751 :			let val maker =
752 :			concat ["mk_", rwro constness, "_", sign, "bf", p]
753 :			in
754 :			pr_fdef (concat ["f_", name, p],
755 :			[EVar "x"],
756 :			EApp (EApp (EVar maker,
757 :			ETuple [EInt offset,
758 :			EWord bits,
759 :			EWord shift]),
760 :			EVar "x"))
761 :			end
762 :
763 :			fun pr_field_acc' { name, spec = S.OFIELD x } =
764 :			let val { synthetic, spec = (c, t), offset, ... } = x
765 :			in
766 :			if synthetic then ()
767 :			else pr_fdef (concat ["f_", name, "'"],
768 :			[EConstr (EVar "x",
769 :			Suobj''c (StUn tag))],
770 :			EConstr (EApp (EApp (EVar "mk_field'",
771 :			EInt offset),
772 :			EVar "x"),
773 :			obj_ty "'" (t, cro c)))
774 :			end
775 :			| pr_field_acc' { name, spec = S.SBF bf } =
776 :			pr_bf_acc (name, "'", "s", bf)
777 :			| pr_field_acc' { name, spec = S.UBF bf } =
778 :			pr_bf_acc (name, "'", "u", bf)
779 :
780 :			fun pr_field_acc { name, spec = S.OFIELD { offset,
781 :			spec = (c, t),
782 :			synthetic } } =
783 :			if synthetic then ()
784 :			else let
785 :			val maker = concat ["mk_", rwro c, "_field"]
786 :			val rtival = EVar ("typ_f_" ^ name)
787 :			in
788 :			pr_fdef ("f_" ^ name,
789 :			[EVar "x"],
790 :			EApp (EApp (EApp (EVar maker, rtival),
791 :			EInt offset),
792 :			EVar "x"))
793 :			end
794 :			| pr_field_acc { name, spec = S.SBF bf } =
795 :			pr_bf_acc (name, "", "s", bf)
796 :			| pr_field_acc { name, spec = S.UBF bf } =
797 :			pr_bf_acc (name, "", "u", bf)
798 :			in
799 :			nl ();
800 :			str (concat ["structure ", K, "_", tag, " = struct"]);
801 :			Box 4;
802 :			nl (); str (concat ["open ", K, "_", tag]);
803 :			app pr_field_typ fields;
804 :			app pr_field_rti fields;
805 :			app pr_field_acc' fields;
806 :			app pr_field_acc fields;
807 :			endBox ();
808 :			nl (); str "end"
809 :			end
810 :
811 :			fun pr_struct_structure { tag, size, anon, fields } =
812 :			pr_su_structure (St, "s", "S", tag, size, fields)
813 :			fun pr_union_structure { tag, size, anon, largest, all } =
814 :			pr_su_structure (Un, "u", "U", tag, size, all)
815 :
816 :			fun pr_gty_rti { name, spec } =
817 :			pr_vdef ("typ_t_" ^ name, rti_val spec)
818 :
819 :			fun pr_addr (prefix, name) =
820 :			pr_vdef (prefix ^ name,
821 :			EApp (EApp (EVar "D.lib_symbol", EVar "so_h"),
822 :			EString name))
823 :
824 :			fun pr_gvar_addr { name, spec } = pr_addr ("gh_", name)
825 :
826 :			fun pr_gvar_obj { name, spec = (c, t) } = let
827 :			val rwobj = EApp (EApp (EVar "mk_obj", rti_val t),
828 :			EApp (EVar "D.addr", EVar ("gh_" ^ name)))
829 :			val obj = case c of S.RW => rwobj
830 :			| S.RO => EApp (EVar "ro", rwobj)
831 :			in
832 :			pr_fdef ("g_" ^ name, [ETuple []], obj)
833 :			end
834 :
835 :			fun pr_gfun_rti { name, spec } =
836 :			pr_vdef ("typ_fn_" ^ name, rti_val (S.FPTR spec))
837 :
838 :			fun pr_gfun_addr { name, spec } = pr_addr ("fnh_", name)
839 :
840 :			fun pr_gfun_fptr { name, spec } =
841 :			pr_fdef ("fptr_fn_" ^ name,
842 :			[ETuple []],
843 :			EApp (EApp (EVar "mk_fptr", EVar ("typ_fn_" ^ name)),
844 :			EApp (EVar "D.addr", EVar ("fnh_" ^ name))))
845 :
846 :			fun pr_gfun_func is_light { name, spec = { args, res } } = let
847 :			val p = if is_light then "'" else ""
848 :			val ml_vars =
849 :			rev (#1 (foldl (fn (_, (l, i)) =>
850 :			(EVar ("x" ^ Int.toString i) :: l,
851 :			i + 1))
852 :			([], 1)
853 :			args))
854 :			fun app0 (what, e) =
855 :			if is_light then e else EApp (EVar what, e)
856 :			fun light (what, e) = app0 ("Light." ^ what, e)
857 :			fun heavy (what, t, e) =
858 :			if is_light then e
859 :			else EApp (EApp (EVar ("Heavy." ^ what), rti_val t), e)
860 :
861 :			fun oneArg (e, t as (S.SCHAR | S.UCHAR | S.SINT | S.UINT |
862 :			S.SSHORT | S.USHORT | S.SLONG | S.ULONG |
863 :			S.FLOAT | S.DOUBLE)) =
864 :			EApp (EVar ("Cvt.c_" ^ stem t), e)
865 :			| oneArg (e, (S.STRUCT _ | S.UNION _)) =
866 :			EApp (EVar "ro'", light ("obj", e))
867 :			| oneArg (e, S.PTR (_, t)) =
868 :			(case incomplete t of
869 :			SOME (K, tag) =>
870 :			app0 (istruct (K, tag) ^ ".light", e)
871 :			| NONE => light ("ptr", e))
872 :			| oneArg (e, S.FPTR _) = light ("fptr", e)
873 :			| oneArg (e, S.VOIDPTR) = e
874 :			| oneArg (e, S.ARR _) = raise Fail "array argument type"
875 :			val c_exps = ListPair.map oneArg (ml_vars, args)
876 :	blume	831	val (ml_vars, c_exps) =
877 :			case res of
878 :			SOME (S.STRUCT _ | S.UNION _) =>
879 :			(EVar "x0" :: ml_vars,
880 :			light ("obj", EVar "x0") :: c_exps)
881 :			| _ => (ml_vars, c_exps)
882 :	blume	828	val call = EApp (EVar "call",
883 :			ETuple [EApp (EVar ("fptr_fn_" ^ name),
884 :			ETuple []),
885 :			ETuple c_exps])
886 :			val ml_res =
887 :			case res of
888 :			SOME (t as (S.SCHAR | S.UCHAR | S.SINT | S.UINT |
889 :			S.SSHORT | S.USHORT | S.SLONG | S.ULONG |
890 :			S.FLOAT | S.DOUBLE)) =>
891 :			EApp (EVar ("Cvt.ml_" ^ stem t), call)
892 :			| SOME (t as (S.STRUCT _ | S.UNION _)) =>
893 :			heavy ("obj", t, call)
894 :			| SOME (S.PTR (_, t)) =>
895 :			(case incomplete t of
896 :			SOME (K, tag) =>
897 :			app0 (istruct (K, tag) ^ ".heavy", call)
898 :			| NONE => heavy ("ptr", t, call))
899 :			| SOME (t as S.FPTR _) => heavy ("fptr", t, call)
900 :			| SOME (S.ARR _) => raise Fail "array result type"
901 :			| (NONE | SOME S.VOIDPTR) => call
902 :			in
903 :			pr_fdef (concat ["fn_", name, p], [ETuple ml_vars], ml_res)
904 :			end
905 :
906 :			fun pr_isu_arg (K, tag) =
907 :			(sp (); str (concat ["structure ", istruct (K, tag),
908 :			" : POINTER_TO_INCOMPLETE_TYPE"]))
909 :			fun pr_istruct_arg tag = pr_isu_arg ("S", tag)
910 :			fun pr_iunion_arg tag = pr_isu_arg ("U", tag)
911 :
912 :			fun pr_isu_def (kw, K, tag) = let
913 :			val n = istruct (K, tag)
914 :			in
915 :			nl ();
916 :			str (concat [kw, " ", n, " = ", n])
917 :			end
918 :			fun pr_istruct_res tag = pr_isu_def ("where", "S", tag)
919 :			fun pr_iunion_res tag = pr_isu_def ("where", "U", tag)
920 :			fun pr_istruct_def tag = pr_isu_def ("structure", "S", tag)
921 :			fun pr_iunion_def tag = pr_isu_def ("structure", "U", tag)
922 :
923 :			fun pr_pre_su (K, k, STUN, StUn, tag, size) =
924 :			(nl (); str (concat ["structure ", K, "_", tag, " = struct"]);
925 :			VBox 4;
926 :			pr_tdef ("tag", Type (concat [k, "_", tag]));
927 :			pr_vdef ("size",
928 :			EConstr (EApp (EVar "C_Int.mk_su_size", EWord size),
929 :			Con ("C.S.size",
930 :			[Con ("C.su", [StUn tag])])));
931 :			pr_vdef ("typ", EApp (EVar "C_Int.mk_su_typ", EVar "size"));
932 :			endBox ();
933 :			nl (); str "end")
934 :
935 :			fun pr_pre_struct { tag, size, anon, fields } =
936 :			pr_pre_su ("S", "s", S.STRUCT, St, tag, size)
937 :			fun pr_pre_union { tag, size, anon, largest, all } =
938 :			pr_pre_su ("U", "u", S.UNION, Un, tag, size)
939 :			in
940 :			(* Generating the functor file... *)
941 :			str dontedit;
942 :			nl (); str credits;
943 :			nl (); str commentsto;
944 :			nl ();
945 :			str (concat ["structure ", strname, " = struct"]);
946 :			VBox 4;
947 :
948 :			if length structs + length unions <> 0 then
949 :			(nl (); str "local";
950 :			VBox 4;
951 :			nl (); str "open Tag";
952 :			endBox ();
953 :			nl (); str "in";
954 :			VBox 4;
955 :			(* definitions for struct/union tags *)
956 :			app pr_struct_tag structs;
957 :			app pr_union_tag unions;
958 :			endBox ();
959 :			nl (); str "end")
960 :			else ();
961 :
962 :			(* "pre"-structures for all structures and unions *)
963 :			app pr_pre_struct structs;
964 :			app pr_pre_union unions;
965 :
966 :			(* the main functor *)
967 :			nl ();
968 :			str "functor"; nsp (); str (strname ^ "Fn");
969 :			HOVBox 4;
970 :			sp ();
971 :			PP.openHVBox strpp (PP.Rel 1);
972 :			str "(";
973 :	blume	829	pr_vdecl ("library", Type "DynLinkage.lib_handle");
974 :	blume	828	app pr_istruct_arg incomplete_structs;
975 :			app pr_iunion_arg incomplete_unions;
976 :			str ")";
977 :			endBox ();
978 :			sp (); str ":"; sp (); str signame;
979 :			VBox 4;
980 :			app pr_istruct_res incomplete_structs;
981 :			app pr_iunion_res incomplete_unions;
982 :			endBox ();
983 :			nsp (); str "=";
984 :			endBox ();
985 :			nl (); str "struct";
986 :			VBox 4;
987 :
988 :			(* copy definitions for struct/union tags *)
989 :			app pr_struct_tag_copy structs;
990 :			app pr_union_tag_copy unions;
991 :
992 :			(* other local stuff (to define RTI for function pointers) *)
993 :			nl (); str "local";
994 :			VBox 4;
995 :			nl (); str "structure D = DynLinkage";
996 :			nl (); str "open C.Dim C_Int";
997 :
998 :			(* low-level call operations for all function pointers *)
999 :			app pr_fptr_rti fptr_types;
1000 :
1001 :	blume	829	(* the library handle (handle on shared object) *)
1002 :			nl (); str "val so_h = library";
1003 :	blume	828	(* addr handles for global variables *)
1004 :			app pr_gvar_addr gvars;
1005 :			(* addr handles for global C functions *)
1006 :			app pr_gfun_addr gfuns;
1007 :
1008 :			endBox ();
1009 :			nl (); str "in";
1010 :			VBox 4;
1011 :			(* carry-throughs for incomplete types *)
1012 :			app pr_istruct_def incomplete_structs;
1013 :			app pr_iunion_def incomplete_unions;
1014 :			(* ML structures corresponding to C struct declarations *)
1015 :			app pr_struct_structure structs;
1016 :			(* ML structurse corresponding to C union declarations *)
1017 :			app pr_union_structure unions;
1018 :
1019 :			(* RTI for C typedefs *)
1020 :	blume	836	app pr_gty_rti cgtys;
1021 :	blume	828	(* (suspended) objects for global variables *)
1022 :			app pr_gvar_obj gvars;
1023 :			(* RTI for function pointers corresponding to global C functions *)
1024 :			app pr_gfun_rti gfuns;
1025 :			(* (suspended) function pointers for global C functions *)
1026 :			app pr_gfun_fptr gfuns;
1027 :			(* ML functions corresponding to global C functions *)
1028 :			app (pr_gfun_func true) gfuns;(* light *)
1029 :			app (pr_gfun_func false) gfuns;(* heavy *)
1030 :			endBox ();
1031 :			nl (); str "end"; (* local *)
1032 :			endBox ();
1033 :			nl (); str "end"; (* functor/struct *)
1034 :			endBox ();
1035 :			nl (); str "end"; (* structure/struct *)
1036 :			nl ();
1037 :
1038 :			PP.closeStream strpp
1039 :			end
1040 :
1041 :			fun do_cm_file () = let
1042 :			val cmpp = openPP cmfile
1043 :
1044 :			fun nl () = PP.newline cmpp
1045 :			fun str s = PP.string cmpp s
1046 :			fun sp () = PP.space cmpp 1
1047 :			fun nsp () = PP.nbSpace cmpp 1
1048 :			fun VBox a = PP.openVBox cmpp (PP.Abs a)
1049 :			fun endBox () = PP.closeBox cmpp
1050 :			fun line s = (nl (); str s)
1051 :			val ls =
1052 :			case lambdasplit of
1053 :			NONE => ""
1054 :			| SOME s => concat ["\t(lambdasplit:", s, ")"]
1055 :			in
1056 :			(* Generating the .cm file... *)
1057 :			str dontedit;
1058 :			line credits;
1059 :			line commentsto;
1060 :			line "(primitive c-int)";
1061 :			line "library";
1062 :			VBox 4;
1063 :			line ("signature " ^ signame);
1064 :			line ("structure " ^ strname);
1065 :			endBox ();
1066 :			line "is";
1067 :			VBox 4;
1068 :			app line ["$/basis.cm","$/c-int.cm", "$smlnj/init/init.cmi : cm"];
1069 :			line (sigfile ^ ls);
1070 :			line (strfile ^ ls);
1071 :			endBox ();
1072 :			nl ();
1073 :
1074 :			PP.closeStream cmpp
1075 :			end
1076 :			in
1077 :			do_sig_file ();
1078 :			do_fct_file ();
1079 :			do_cm_file ()
1080 :			end
1081 :			end
1082 :			end

---

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